Hpotter
XLDnaute Junior
Bonjour à tous,
Le code ci-dessous me permet de remplir des feuilles de calcul se trouvant dans plusieurs fichiers en dehors du fichier "Maître" que j'ai appelé "Factures".
Ces feuilles sont recherchées selon les données se trouvant dans 2 Combo,
CmbListCred et CmbMarche.
CmbListCred est une saisie obligatoire donc pas de soucis particulier. Par contre, CmbMarche n'est pas obligatoire et c'est là que ça coince, si rien n'est saisi dans cette zone, toute la procédure plante.
Comment passer outre la partie grisée de mon code sans bloquer tout le reste ?
Merci par avance pour votre aide
Le code ci-dessous me permet de remplir des feuilles de calcul se trouvant dans plusieurs fichiers en dehors du fichier "Maître" que j'ai appelé "Factures".
Ces feuilles sont recherchées selon les données se trouvant dans 2 Combo,
CmbListCred et CmbMarche.
CmbListCred est une saisie obligatoire donc pas de soucis particulier. Par contre, CmbMarche n'est pas obligatoire et c'est là que ça coince, si rien n'est saisi dans cette zone, toute la procédure plante.
Comment passer outre la partie grisée de mon code sans bloquer tout le reste ?
Merci par avance pour votre aide
Code:
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
[COLOR="Red"][B]‘Ici on recherche le fichier « Recap prest.xls
‘Si le fichier n’existe pas on le créé[/B][/COLOR]
If Dir(stFichierComp) = "" Workbooks.Add (1)
NewRec = True
Set wbkRecap = ActiveWorkbook
[COLOR="red"][B]'On nomme la première feuille[/B][/COLOR]
Set shtRecap = wbkRecap.ActiveSheet
shtRecap.Name = "L" & NumLig
wbkRecap.SaveAs Filename:=stFichierComp
Else
[COLOR="red"][B]‘Si le fichier « recap prest.xls existe[/B][/COLOR]
Set wbkRecap = Workbooks.Open(stFichierComp)
Exist = False
For Each ws In Worksheets
If ws.Name = "L" & NumLig Then
[COLOR="red"][B]‘On recherche la feuille correspondant à Me.CmbListeCred.Value[/B][/COLOR]
Set shtRecap = ws
Exist = True
Exit For
End If
Next ws
If Not Exist Then
[COLOR="red"][B]‘Si elle n’existe pas on la créée[/B][/COLOR]
Set shtRecap = wbkRecap.Sheets.Add(Type:=xlWorksheet)
shtRecap.Name = "L" & NumLig
NewRec = True
End If
End If
[COLOR="red"][B]‘Si le fichier « Batiprix.xls » n’existe pas, on le créé[/B][/COLOR]
[B]If Dir(stFichComp) = "" Then
Workbooks.Add (1)
NewRech = True[/B]
[COLOR="red"][B]‘On nomme la première feuille[/B][/COLOR]
[B]Set wbkBatiprix = ActiveWorkbook
Set shtBati = wbkBatiprix.ActiveSheet
shtBati.Name = NumLign
wbkBatiprix.SaveAs Filename:=stFichComp
Else[/B]
[/B][/B][/B][COLOR="red"][B]‘Si le fichier existe[/B][/COLOR]
[B]Set wbkBatiprix = Workbooks.Open(stFichComp)
Existe = False
For Each wst In Worksheets
If wst.Name = NumLign Then[/B]
[COLOR="red"][B]‘On recherche la feuille correspondant à Me.CmbMarche.Value [/B][/COLOR]
[B]Set shtBati = wst
Existe = True
Exit For
End If
Next wst
If Not Existe Then[/B]
[COLOR="red"][B]'Sinon on ajoute une nouvelle feuille[/B][/COLOR]
[B]Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet)
shtBati.Name = NumLign
NewRech = True
End If
End If[/B]
[COLOR="red"][B]‘On recopie les données du fichier « Factures.xls » dans chaque feuille affichée de chaque fichier ouvert.[/B][/COLOR]
'-------------------------------------------------------
[B]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[/B]
'-------------------------------------------------------
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
'---------------------------------------------------------
wbkRecap.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
Dernière édition: