[VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

[R@chid]

Bonsoir tout le monde,
Ce R@chid ne va pas cesser de poser les question ??
Non je ne vais pas cesser..

Comme vous allez voir sur le fichier joint, ( mes amis sur le forum m'ont beaucoup aidé à le faire ), je peux créer un nouveau devis sur un nouvel onglet, imprimer les devis après filtre, récupérer les montants TTC et HT des nouveaux devis, mais le problème avec les devis sur le même fichier c'est que après un certain temps il y aura un problème de ralentissement de fichier avec 200 ou 300 devis, alors je me demande si on peut faire la même chose mais cette fois avec des devis sur un fichier chacun donc à la place de créer un nouvel onglet, créer un nouveau classeur avec un seul onglet (Onglet et Classeur portant le même nom) tout en gardant la possibilité d'imprimer ces classeurs après filtres et en récupérant les montant TTC/HT après l'enregistrement de ces derniers..

Je pense que j'ai appris à rédiger les questions

@ + +

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,
Ok Job75, merci c'est parfait..
Maintenant j'ai l'embarras du choix

@ + +

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

Maintenant j'ai l'embarras du choix

Oui, mais perso je préfère la solution (6).

Le retour au fichier de base se fera toujours sans délai après la création d'un devis.

Alors qu'il y aura un délai avec la version (5) du fait de la macro Workbook_Activate.

S'il n'y a pas eu de message à l'ouverture, grâce aux formules on est sûr des montants en colonnes I et J.

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,
Je comprends bien ce que tu veux dire mon cher ami à propos du délai, mais je ne voie pas que l'on va remarquer avec 300 ou 400 devis, et surtout que le PC du Bureau est un Core-i3 avec 4 Go de Ram..

Pour le msg je ne comprend pas ce que tu veux dire, puisque à chaque ouverture du fichier je voie apparaitre ce msg :

Que je supprime un devis ou non, ce msg apparait

@ + +

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

Bon c'est classique, ce message peut être facilement évité.

Onglet Fichier => Options => Options avancées, et en bas dans Général, décocher l'option :

Confirmation de la mise à jour automatique des liens.

Je parlais d'un autre message qui apparait toujours quand le lien ne peut pas être mis à jour.

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

Onglet Fichier => Options => Options avancées, et en bas dans Général, décocher l'option

J'ai pensé que l'on peut faire autrement en adaptant un truc sur la macro, mais bon puisque ça a un rapport avec la RECHERCHEV() sur les autres classeurs.

Je parlais d'un autre message qui apparait toujours quand le lien ne peut pas être mis à jour.

Oui je l'ai vu après la suppression d'un devis de dossier, merci.

Quelques questions qui se posent :
1) J'ai essayé d'enlever le Timer mais je n'ai pas pu ??
2) Comment tu as pu créer 1000 devis en un seul coup, j'ai envie de faire un test pour mes employeurs (3 associés), mais c'est pas facile de le faire manuellement, et je suis sûr que toi aussi avec ton large expérience tu ne vas pas le faire manuellement ??

Il y avait une 3ème question qui m'est échappée

@ te relire

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

1) Pour enlever le message du Timer mets en commentaire ou retire la MsgBox à la fin de la macro.

2) Pour créer 1000 devis :

- j'ai entré en A3 la formule =LIGNE()-2

- copié la ligne 3

- sélectionné les lignes 4:1002 (touche F5) puis => Coller

Puis j'ai lancé la macro existante "légèrement" modifiée :

Sub AjoutDevis()
  Dim i, Ind As Integer, LigSel As Long, NomSht As String
  Dim ShtTdB As Worksheet, fich As String
  Set ShtTdB = Sheets("TableauDeBord")
For i = 1 To 1000
  [A2].Offset(i).Select
  LigSel = Selection.Row
  For Ind = 0 To 4
    If ShtTdB.Cells(LigSel, 1 + Ind).Value = "" Then
      MsgBox "Le devis ne peut pas être créé, il manque une information" _
       , vbExclamation, "Attention..."
      ShtTdB.Cells(LigSel, 1 + Ind).Select
      Exit Sub
    End If
  Next Ind
  NomSht = Range("A" & LigSel)
  fich = ThisWorkbook.Path & "\" & NomSht 'chemin à adapter
  If Dir(fich & ".xls*") <> "" Then _
    MsgBox "Le devis a déjà été créé...": Exit Sub
  For Ind = 1 To Len(NomSht)
    If InStr("][\/:*?""<>|", Mid(NomSht, Ind, 1)) Then _
      MsgBox "Les caractères  ] [ \ / : * ? "" <> | sont interdits...": Exit Sub
  Next
  Application.ScreenUpdating = False 'c'est mieux
  ThisWorkbook.Unprotect "Rachid" 'mot de passe
  With Sheets("DEVIS_V")
    .Visible = True
    .Copy 'nouveau document
    .Visible = False
  End With
  ThisWorkbook.Protect "Rachid"
  With ActiveWorkbook.Sheets(1)
    .Name = Left(NomSht, 31)
    .Range("J1") = NomSht
    .Range("J2") = ShtTdB.Range("B" & LigSel)
    .Range("B1") = ShtTdB.Range("C" & LigSel)
    .Range("B2") = ShtTdB.Range("D" & LigSel)
    .Range("H44") = ShtTdB.Range("E" & LigSel)
    .Parent.SaveAs fich
    fich = Dir(fich & ".xls*")
    ShtTdB.Cells(LigSel, 9) = "=VLOOKUP(""*TTC*"",'[" & fich & "]" & Left(NomSht, 31) & "'!A1:J200,10,0)"
    ShtTdB.Cells(LigSel, 10) = "=VLOOKUP(""*HT*"",'[" & fich & "]" & Left(NomSht, 31) & "'!A1:J200,10,0)"
    .Parent.Close False 'indispensable...
  End With
Next i
End Sub

Evidemment ça prend un peu de temps, mais on suit ce qui se passe.

Edit : j'oubliais, bien sûr mets tout ça dans un nouveau dossier créé sur le bureau.

Pour pouvoir facilement tout supprimer ensuite.

Bonne nuit.

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,
Ok merci parfait, je vais voir comment fonctionne cette dernière macro.

Bonne nuit.

@ + +

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,

J'oubliais, bien sûr mets tout ça dans un nouveau dossier créé sur le bureau.

Pour pouvoir facilement tout supprimer ensuite.

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re,
Oui je sais c'est ce que je fais pour les tests.
Merci
@ + +

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour R@chid, le forum,

Il manquait encore la mise à jour du lien hypertexte du bouton lors de la création du devis :

.Shapes(1).Hyperlink.Address = ThisWorkbook.FullName

Si bien sûr tu tiens à conserver ce bouton...

Fichier (7).

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour,
Merci Job75,
Pour moi j'ai décidé de négliger et annuler ce bouton, car en fait je l'ai utilisé pour retourner de l'onglet devis vers l'onglet "TabeauDeBord" car on aura des dizaines d'onglets sur le même fichier, et je ne suis pas le seul utilisateur de fichier alors que pour les autres je sais très bien qu'il vont trouver une difficulté d'y retourner, mais pour naviguer entre les fichiers on va ouvrir au maximum 4 fichiers donc la navigation va être facile.

Merci d'en avoir penser je vais bien m'en servir, pourquoi pas

@ + +

Edit :
Est-il possible d'adapter la Macro d'ouverture de devis, pour que si le devis est déjà ouvert il me met directement dessus sans essayer de le rouvrir encore une fois pour ne pas avoir ce msg :

 

[job75]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re R@chid,

En effet c'est mieux comme ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim derlig As Long, chemin As String, fich As String
  derlig = Range("A" & Application.Rows.Count).End(xlUp).Row
  If Not Application.Intersect(Target, Range("A3:A" & derlig)) Is Nothing Then
    Cancel = True
    chemin = ThisWorkbook.Path & "\" 'à adapter
    fich = Dir(chemin & Target & ".xls*")
    If fich = "" Then MsgBox "Le devis " & Target & " n'existe pas...": Exit Sub
    On Error Resume Next
    Workbooks(fich).Activate
    If Err Then Workbooks.Open chemin & fich
  End If
End Sub

Fichier (8).

A+

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Re Job75,
En effet c'est exactement ça
Merci l'ami pour ton aide précieuse, je viens de naître et déjà tu m’as couvert de cadeaux

@ + +

 

[R@chid]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonsoir @ tous,
Un salut à Job75,

Private Sub Workbook_Activate()
Dim chemin As String, derlig As Long, tablo, i As Long, fich As String
Sheets("TB_DEVIS").Activate
chemin = "C:\Documents and Settings\R@chid\Bureau\DEVIS_FACTURES" & "\"
derlig = Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & derlig) = "" Then derlig = derlig - 1
tablo = Range("A3:J" & derlig)
For i = 1 To UBound(tablo)
  fich = Dir(chemin & tablo(i, 1) & ".xls*")
  tablo(i, 9) = "": tablo(i, 10) = ""
  If fich <> "" Then
    tablo(i, 9) = ExecuteExcel4Macro("VLOOKUP(""*TTC*"",'" & chemin & "[" & fich & "]" & tablo(i, 1) & "'!R1C1:R200C10,10,0)")
    tablo(i, 10) = ExecuteExcel4Macro("VLOOKUP(""*HT*"",'" & chemin & "[" & fich & "]" & tablo(i, 1) & "'!R1C1:R200C10,10,0)")
  End If
Next
Application.EnableEvents = False
[I3].Resize(i - 1).Formula = Application.Index(tablo, , 9)
[J3].Resize(i - 1).Formula = Application.Index(tablo, , 10)
Application.EnableEvents = True
End Sub

Pour ce code là, il me renvoie des résultats erronés quand je fais des filtres sur le tableau pour n'afficher que les devis d'un client à une tel mois par exemple..

Voir un type de résultats que j'obtiens.

c'est toujours les mêmes resultats mais parfois des montant différents


@ te lire

 

[Zdz16]

Re : [VBA] Nouveau devis sur un nouveau fichier et pas nouvel Onglet

Bonjour;

Que pensez-vous, il serai pas judicieux de faire un modèle et à chaque devis utiliser ce modèle de sorte à enregistrer le devis dans un seul fichier. Voir même le modèle peut contenir le devis et la facture.

C'est une idée ?.

Cordialement