Aide pour complèter un code Vba

Version imprimable

Bonjour à tous,

Le code ci-dessous me permet de créer une feuille de calcul dans un fichier lorsque le numéro afficher dans une Combo n'existe pas et d'y insérer des éléments saisis. Par contre, si la feuille existe, seules les données sont saisies dans la feuille correspondante.

Cependant, je rencontre un problème, lorsque la Combo est vide, j'ai un message d'erreur sur la ligne en gras, ce qui est normal puisque dans mon cas il est censé y avoir un numéro dans la combo (CmbMarche) qui correspond à NumLign du code.

Donc, comment ajouter un boût de code qui lorsque la combo est vide, n'ouvre pas le fichier et ne créé pas la feuille.

Merci par avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 If Dir(stFichComp) = "" Then 'Si le fichier Récap prest.xls n'existe pas, on le crée Workbooks.Add (1) NewRech = True Set wbkBatiprix = ActiveWorkbook 'On nomme la première feuille Set shtBati = wbkBatiprix.ActiveSheet shtBati.Name = NumLign wbkBatiprix.SaveAs Filename:=stFichComp Else Set wbkBatiprix = Workbooks.Open(stFichComp) 'Si le fichier Récap prest.xls existe Existe = False For Each wst In Worksheets If wst.Name = NumLign Then 'On cherche si la feuille Lx, avec x=n° ligne existe Set shtBati = wst Existe = True Exit For End If Next wst If Not Existe Then Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet) 'Sinon on ajoute une nouvelle feuille nommée Lx shtBati.Name = NumLign NewRech = True End If End If

28/09/2010, 17h36
mercatog

Commence le code par

Code:

if TaCombo<>"" then

Bonjour mercatog et à tous,

J'ai bien pensé à cela, mais je ne sais pas quoi mettre après "then", car la procédure doit aller jusqu'au boût de l'ensemble du code, sans prendre en considération la partie en gras.

Voici le code complet désolé c'est un peu long, mais pour une bonne compréhension du sujet cela me semble utile.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Private Sub CmbOk_Click()
Dim erreur(7) As Boolean, msg As String, i As Byte
Dim Tablo As Variant
 
'Ver = 0
Tablo = Array("", "La ligne de crédit ?", "Le tiers ?", "Le site ?", "L'objet ?", "Le n° d'engagement ?", "Le montant ?", "Qui engage ?")
erreur(1) = Me.CmbListeCred = ""
erreur(2) = Me.CmbListeTiers = ""
erreur(3) = Me.CmbListeBat = ""
erreur(4) = Me.TxtObjet = ""
erreur(5) = Me.TxtNum = ""
erreur(6) = Me.TxtMontant = ""
erreur(7) = Me.CmbNom = ""
For i = 1 To 7
    If erreur(i) Then msg = msg & vbCrLf & "-" & " " & Tablo(i)
Next
If msg <> "" Then
    MsgBox "Vous avez oublié" & msg, 0, "A vérifier"
    Exit Sub
End If
 
If Trouve_Identique("D", Me.TxtNum.Value) Then
    MsgBox "Attention ce numéro d'engagement existe dèjà ... Veuillez vérifier", vbError + vbOKOnly
Else
    TestA
    End If
UFengt.CmbListeCred.SetFocus
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Sub TestA()
Dim wbkRecap As Workbook, wbkBatiprix As Workbook
Dim shtFact As Worksheet, shtRecap As Worksheet, shtBati As Worksheet
Dim LastLigF As Long, LastLigR As Long
Dim stFichierComp As String, NumLig As String
Dim stFichComp As String, NumLign As String
Dim NewRec As Boolean, Exist As Boolean
Dim NewRech As Boolean, Existe As Boolean
 
Application.ScreenUpdating = False
Set shtFact = ThisWorkbook.Sheets("Engagements")
NumLig = Me.CmbListeCred.Value
NumLign = Me.CmbMarche.Value
stFichierComp = "S:\FACTURES\FACTURES 2011\Recap prest.xls"
stFichComp = "S:\FACTURES\FACTURES 2011\Batiprix.xls"
NewRec = False
NewRech = False


If Dir(stFichierComp) = "" Then                                     'Si le fichier Récap prest.xls n'existe pas, on le crée
    Workbooks.Add (1)
    NewRec = True
    Set wbkRecap = ActiveWorkbook                                   'On nomme la première feuille
    Set shtRecap = wbkRecap.ActiveSheet
        shtRecap.Name = "L" & NumLig
        wbkRecap.SaveAs Filename:=stFichierComp
Else
    Set wbkRecap = Workbooks.Open(stFichierComp)                    'Si le fichier Récap prest.xls existe
    
    Exist = False
    For Each ws In Worksheets
        If ws.Name = "L" & NumLig Then                              'On cherche si la feuille Lx, avec x=n° ligne existe
            Set shtRecap = ws
            Exist = True
            Exit For
        End If
    Next ws
    If Not Exist Then
        Set shtRecap = wbkRecap.Sheets.Add(Type:=xlWorksheet)       'Sinon on ajoute une nouvelle feuille nommée Lx
        shtRecap.Name = "L" & NumLig
        NewRec = True
    End If
End If

If Dir(stFichComp) = "" Then                                     'Si le fichier Bâtiprix.xls n'existe pas, on le crée
    Workbooks.Add (1)
    NewRech = True
    Set wbkBatiprix = ActiveWorkbook                                   'On nomme la première feuille
    Set shtBati = wbkBatiprix.ActiveSheet
        shtBati.Name = NumLign
        wbkBatiprix.SaveAs Filename:=stFichComp
Else
    Set wbkBatiprix = Workbooks.Open(stFichComp)                    'Si le fichier Bâtiprix.xls existe
        Existe = False
    For Each wst In Worksheets
            If wst.Name = NumLign Then                              'On cherche si la feuille Lx, avec x=n° ligne existe
            Set shtBati = wst
            Existe = True
            Exit For
        End If
    Next wst
    If Not Existe Then
        Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet)       'Sinon on ajoute une nouvelle feuille nommée Lx
        shtBati.Name = NumLign
        NewRech = True
    End If
End If


With shtFact   '-------------------------------------------------------
    LastLigF = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & LastLigF).Value = LastLigF - 5
    .Range("B" & LastLigF).Value = Me.TxtDate.Value
    .Range("B" & LastLigF).Value = Format(Me.TxtDate, "mm-dd-yyyy")
    .Range("C" & LastLigF).Value = NumLig
    .Range("D" & LastLigF).Value = Me.TxtNum.Value
    .Range("E" & LastLigF).Value = Me.TxtNumDev.Value
    .Range("F" & LastLigF).Value = Me.TxtDevis.Value
    .Range("F" & LastLigF).Value = Format(Me.TxtDevis, "mm-dd-yyyy")
    .Range("G" & LastLigF).Value = Me.CmbListeTiers.Value
    .Range("I" & LastLigF).Value = Me.CmbListeBat.Value
    .Range("J" & LastLigF).Value = Me.TxtObjet.Value
    .Range("K" & LastLigF).Value = Me.TxtMontant.Value
    .Range("M" & LastLigF).Value = Me.CmbNom.Value
    .Range("N" & LastLigF).Value = Me.CmbMarche.Value
    .Range("L" & LastLigF).Value = Me.TxtNome.Value
End With
'---------------------------------------------------------
With shtRecap
    If NewRec Then
        .Range("B3").Value = "Engagement"
        .Range("C3").Value = "Bâtiment"
        .Range("D3").Value = "Travaux réalisés"
        .Range("E3").Value = "Par"
        .Range("F3").Value = "Libellé"
        .Range("G3").Value = "Montant"
    End If
    
    LastLigR = .Range("B65536").End(xlUp).Row + 1
    
    .Range("B" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("G" & LastLigF).Value
    .Range("G" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
End With
'---------------------------------------------------------
With shtBati
    If NewRech Then
        .Range("A3").Value = "N° Engagement"
        .Range("B3").Value = "N° Devis"
        .Range("C3").Value = "Date"
        .Range("D3").Value = "Montant"
        .Range("E3").Value = "Site"
        .Range("F3").Value = "Objet"
    End If    
    LastLigR = .Range("A65536").End(xlUp).Row + 1
    
    .Range("A" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("B" & LastLigR).Value = shtFact.Range("E" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("F" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("F" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
End With


wbkRecap.Close savechanges:=True
wbkBatiprix.Close savechanges:=True

Load UFengt
For i = 1 To 4
    With Sheets("BC" & i)
        .Range("B24").Value = Me.CmbListeBat.Value
        .Range("B25").Value = Me.CmbNom.Value
        .Range("D24").Value = Me.CmbNom.Value
        .Range("G6").Value = CDate(Me.TxtDate)
        .Range("H14").Value = Me.CmbListeCred.Value
        .Range("N11").Value = Me.CmbListeTiers.Value
        .Range("N15").Value = Me.TxtNum.Value
        .Range("N17").Value = Me.CmbMarche.Value
        .Range("N19").Value = Me.TxtNome.Value
    End With
Next i
    With Sheets("Ret")
        .Range("C6").Value = Me.TxtNum.Value
        .Range("C8").Value = Me.CmbNom.Value
        .Range("C10").Value = CDate(Me.TxtDate)
        .Range("C12").Value = Me.CmbListeBat.Value
        .Range("C14").Value = Me.TxtObjet.Value
        .Range("C17").Value = Me.CmbListeCred.Value
        .Range("C19").Value = Me.CmbListeTiers.Value
        .Range("C25").Value = Me.CmbMarche.Value
        .Range("C27").Value = Me.TxtNome.Value
        .Range("C29").Value = Me.TxtMontant.Value
        .Range("D4").Value = Me.TnumInc.Value
    .PageSetup.PrintArea = "$A$1:$G$44"
    .Visible = True
        .Visible = False
End With

Set shtFact = Nothing
Set shtRecap = Nothing
Set wbkRecap = Nothing
 
Application.ScreenUpdating = True
 
End Sub

29/09/2010, 09h52
mercatog

sinon, en une ligne

Code:

if tacombo.value="" then exit sub
29/09/2010, 09h57
NEC14

Citation:

Envoyé par mercatog

sinon, en une ligne

Code:

if tacombo.value="" then exit sub

Si je fais cela, est-ce que je ne vais pas directement à la fin de la procédure et qu'elle s'arrête sans faire le reste.

Car comme je l'ai dit, la procédure doit toutefois continuer en remplissant les autres tableaux saut ceux concernés par le fichier Bâtiprix.xls.

Mais peut-être ai-je tort.

Merci

Edit : je viens d'essayer et effectivement toute ma procédure s'arrête.
Il faudrait que j'arrive à faire en sorte que la procédure saute passe directement à With Shtfact sans passer par Shtbati.
Mais là je ne sais pas faire.

Code:

1
2
3
4
if TaCombo<>"" then
'Ton code à exécuter si combo.value est non vide
endif
'suite de ton code indépendant de la valeur de ta combo

Je suis désolé, cela ne fonctionne pas, c'est toute la procédure qui s'interrompt.

Voici ce que j'ai fait :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
 
If Me.CmbMarche <> "" Then
If Dir(stFichComp) = "" Then    'Si le fichier Bâtiprix.xls n'existe pas, on le crée
    Workbooks.Add (1)
    NewRech = True
    Set wbkBatiprix = ActiveWorkbook   'On nomme la première feuille
    Set shtBati = wbkBatiprix.ActiveSheet
        shtBati.Name = NumLign
        wbkBatiprix.SaveAs Filename:=stFichComp
Else
    Set wbkBatiprix = Workbooks.Open(stFichComp) 'Si le fichier Bâtiprix.xls existe
        Existe = False
    For Each wst In Worksheets
            If wst.Name = NumLign Then 'On cherche si la feuille Lx, avec x=n° ligne existe
            Set shtBati = wst
            Existe = True
            Exit For
        End If
    Next wst
    If Not Existe Then
        Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet) 'Sinon on ajoute une nouvelle feuille nommée Lx
        shtBati.Name = NumLign
        NewRech = True
    End If
End If
'-------------------------------------------------------
 
With shtBati
    If NewRech Then
        .Range("A3").Value = "N° Engagement"
        .Range("B3").Value = "N° Devis"
        .Range("C3").Value = "Date"
        .Range("D3").Value = "Montant"
        .Range("E3").Value = "Site"
        .Range("F3").Value = "Objet"
    End If
 
    LastLigR = .Range("A65536").End(xlUp).Row + 1
 
    .Range("A" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("B" & LastLigR).Value = shtFact.Range("E" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("F" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("F" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
End With
wbkBatiprix.Close savechanges:=True
End If

Relis le commentaire mis en fin de ton code ci-joint

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
If Me.CmbMarche <> "" Then
    If Dir(stFichComp) = "" Then    'Si le fichier Bâtiprix.xls n'existe pas, on le crée
        Workbooks.Add (1)
        NewRech = True
        Set wbkBatiprix = ActiveWorkbook    'On nomme la première feuille
        Set shtBati = wbkBatiprix.ActiveSheet
        shtBati.Name = NumLign
        wbkBatiprix.SaveAs Filename:=stFichComp
    Else
        Set wbkBatiprix = Workbooks.Open(stFichComp)    'Si le fichier Bâtiprix.xls existe
        Existe = False
        For Each wst In Worksheets
            If wst.Name = NumLign Then    'On cherche si la feuille Lx, avec x=n° ligne existe
                Set shtBati = wst
                Existe = True
                Exit For
            End If
        Next wst
        If Not Existe Then
            Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet)    'Sinon on ajoute une nouvelle feuille nommée Lx
            shtBati.Name = NumLign
            NewRech = True
        End If
    End If
'-------------------------------------------------------
    With shtBati
        If NewRech Then
            .Range("A3").Value = "N° Engagement"
            .Range("B3").Value = "N° Devis"
            .Range("C3").Value = "Date"
            .Range("D3").Value = "Montant"
            .Range("E3").Value = "Site"
            .Range("F3").Value = "Objet"
        End If
        LastLigR = .Range("A65536").End(xlUp).Row + 1
        .Range("A" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
        .Range("B" & LastLigR).Value = shtFact.Range("E" & LastLigF).Value
        .Range("C" & LastLigR).Value = shtFact.Range("F" & LastLigF).Value
        .Range("D" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
        .Range("E" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
        .Range("F" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
    End With
    wbkBatiprix.Close savechanges:=True
End If
'1. Si Me.CmbMarche <> "", la procédure exécute les lignes ci-dessus et continue le code éventuel en dessous à partir d'ici
'2. Si Me.CmbMarche = "", la procédure commence à partir d'ici
 
'SUITE DU CODE
End Sub

29/09/2010, 15h01
NEC14

Désolé, mais ça ne fonctionne toujours pas.
Je vais modifier les procédures et je te tiens au courant.
Merci pour ton aide et ta patience
A+
29/09/2010, 15h32
patricktoulon

heu!...

bonjour il va te falloir separer certaines fonction dans ta macro
avant
ensuite tu applique la methode de mercatog

et dans la condition negative tu renvoie a la partie restante

au plaisir
29/09/2010, 15h34
NEC14

Bonjour patricktoulon,

C'est exactement ce que je suis en train de faire car je ne vois pas d'autre solution.

Encore merci
A+