Regrouper deux codes sur une macro
p
Bonsoir à tous !!
actuellement j'ai deux boutons avec un code different.
Comment reunir ces deux codes pour que ma macro enregistreconsigneracc execute les deux.
C'est tout bete je sais, mais je me casse le cerveau ..
Je commence à etre accroc a excel
Sub enregistreconsigne()
Dim Chemin As String, Fichier As String
Fichier = Sheets("fiche consigne").Range("E6") & " " & Sheets("fiche consigne").Range("E8") & " " & Sheets("fiche consigne").Range("E9")
If Len(Trim(Fichier)) = 0 Then
MsgBox "Pas de nom de fichier"
Exit Sub
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "g:\perso\gestion\Installations\"
If .Show = -1 Then ' Clic sur Ok
Chemin = .SelectedItems(1)
Else
' Clic sur Annuler
Exit Sub
End If
End With
Sheets("fiche consigne").Copy
With ActiveWorkbook
.SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Sheets("fiche consigne").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End Sub
Sub enregistreraccordement()
Dim Chemin As String, Fichier As String
Fichier = Sheets("fiche raccordement").Range("E6") & " " & Sheets("fiche raccordement").Range("E8")
If Len(Trim(Fichier)) = 0 Then
MsgBox "Pas de nom de fichier"
Exit Sub
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "g:\perso\gestion\Installations\"
If .Show = -1 Then ' Clic sur Ok
Chemin = .SelectedItems(1)
Else
' Clic sur Annuler
Exit Sub
End If
End With
Sheets("fiche raccordement").Copy
With ActiveWorkbook
.SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
Sheets("fiche raccordement").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End SubBonjour
Fournis un fichier pour tester
Sub Enregistre2Feuilles()
Dim Chemin As String, Fichier As String
Dim LesFeuilles, I As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "g:\perso\gestion\Installations\"
If .Show = -1 Then ' Clic sur Ok
Chemin = .SelectedItems(1)
Else
' Clic sur Annuler
Exit Sub
End If
End With
LesFeuilles = Array("fiche consigne", "fiche raccordement")
For I = 0 To UBound(LesFeuilles)
With Sheets(LesFeuilles(I))
Fichier = .Range("E6") & " " & .Range("E8")
If I = 0 Then Fichier = Fichier & " " & .Range("E9") ' Pour la fiche consigne on rajoute E9
If Len(Trim(Fichier)) = 0 Then
MsgBox "Pas de nom de fichier pour la page """ & LesFeuilles(I) & """"
Exit Sub
End If
.Copy
With ActiveWorkbook
.SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close
End With
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=1, to:=1, OpenAfterPublish:=False
End With
Next I
End Subp
Ca fonctionne parfaitement avec ce code merciiiiii