superbog
XLDnaute Occasionnel
Bonjour,
J'ai un classeur avec un onglet HD qui sert de source pour créer des factures (en utilisant la colonne B qui porte les numéros des dossiers), un onglet facture pour lister les factures faites et des onglets dossier (chacun porte le numéro du dossier).
J'ai créé une macro qui me permet d'éditer des factures à condition
Or la première condition, concernant l'onglet, ne fonctionne pas, notamment en boucle...
Voici la macro
ci joint un fichier exemple
Pourriez vous m'aider svp
J'ai un classeur avec un onglet HD qui sert de source pour créer des factures (en utilisant la colonne B qui porte les numéros des dossiers), un onglet facture pour lister les factures faites et des onglets dossier (chacun porte le numéro du dossier).
J'ai créé une macro qui me permet d'éditer des factures à condition
- que l'onglet existe
- que le dossier porte un numéro >9000
- que la facture n'ait pas déjà été faite
Or la première condition, concernant l'onglet, ne fonctionne pas, notamment en boucle...
Voici la macro
Code:
Sub fact_test()
Dim i, t, DerLigBase, lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim FeuilleExist As Boolean
Dim shAct As Worksheet, F As Worksheet, sh1 As Worksheet, Sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet
Dim nomNewClasseur As String
Dim Numfacture As Long
lig = Sheets("HR").range("B9000").End(xlUp).Row + 1
'Recherche de la dernière ligne
DerLigBase = Sheets("HR").range("A9000").End(xlUp).Row
Set sh1 = ThisWorkbook.Sheets("Facture")
Set Sh2 = ThisWorkbook.Sheets("fact")
Set sh3 = ThisWorkbook.Sheets("HR")
Set colFeuille = New Collection
On Error Resume Next
sh3.Activate
'Recherche de la ligne et tri dans chaque feuille
For i = 2 To Sheets("HR").range("B9000").End(xlUp).Row
'Récupère le nom de l'onglet stocké dans la collection
sNomFeuille = Cells(i, 2).Text
'Recherche si cet onglet existe
Set F = Sheets(sNomFeuille)
If F Is Nothing Then GoTo 100
If Sheets("HR").Cells(i, 2) > 9000 Then GoTo 100
If Not IsEmpty(Sheets("HR").Cells(i, 6)) And IsEmpty(Sheets("HR").Cells(i, 9)) Then
Sheets("Facture").range("A9") = Sheets("HR").Cells(i, 2)
Sheets("Facture").range("D35") = Sheets("HR").Cells(i, 4)
Sheets("Facture").range("E35") = "par " & Sheets("HR").Cells(i, 5)
Sheets("Facture").range("F35") = Sheets("HR").Cells(i, 6)
Sheets("HR").Cells(i, 9) = "F"
'incrémente le numéro de facture
Numfacture = Sheets("facture").range("F1").Value
Numfacture = Numfacture + 1
Sheets("facture").range("F1").Value = Numfacture
Sheets("Facture").Activate
'enregistre la facture en pdf
nomNewClasseur = range("F1") & "F -" & range("F9") & "-" & range("A9") & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Brigitte\Dropbox\PARIS VM\factures\" & nomNewClasseur, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, from:=1, To:=1, OpenAfterPublish:=False
Sh2.Cells(i, 2).Value = sh1.range("A9").Value
Sh2.Cells(i, 3).Value = sh1.range("B9").Value
Sh2.Cells(i, 4).Value = sh1.range("F2")
Sh2.Cells(i, 5).Value = sh1.range("F1").Value
Sh2.Cells(i, 6).Value = sh1.range("F21").Value
Sh2.Cells(i, 7).Value = sh1.range("F25").Value
Sh2.Cells(i, 8).Value = sh1.range("F23").Value
Sh2.Cells(i, 9).Value = sh1.range("F27").Value
End If
100 Next i
MsgBox "factures terminées"
End Sub
ci joint un fichier exemple
Pourriez vous m'aider svp