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
| Sub RAPPORT_Bouton6_Cliquer()
Dim LeParcours As String, LeRep As String
LeParcours = Range("H10").Value
Dat = Right(Range("G10").Value, 2)
Dat1 = "HYD20" & Dat
Dim LI
Dim Plage1
Dim Plage2
Dim Plage3
LI = ThisWorkbook.Worksheets("RAPPORT").HPageBreaks(1).Location.Row - 1
Plage1 = "A1:H" & LI
LI2 = LI * 2
Plage2 = "A" & LI + 1 & ":H" & LI2 + 1
Plage3 = "I" & LI + 1 & ":Q" & LI2 + 1
Range(Plage1).Select
Dim Ma_Forme As Shape
Dim i
Dim P
For i = 1 To 2
For Each Ma_Forme1 In Sheets("RAPPORT").Shapes
If Ma_Forme1.Name = "Image" & i Then
Range(Plage1, Plage2).Select
Exit For
End If
Next Ma_Forme1
Next i
Dim o
For o = 3 To 4
For Each Ma_Forme In Sheets("RAPPORT").Shapes
If Ma_Forme.Name = "Image" & o Then
Range(Plage1, Plage2, Plage3).Select
Exit For
End If
Next Ma_Forme
Next o
Dim FSO As Object, sNomDossier As String
Set FSO = CreateObject("Scripting.FileSystemObject")
sNomDossier = "HYD" & LeParcours
Chemin = Sheets("Données").Range("A30").Value
sChemin = Chemin & "\" & Dat1 & "\" & sNomDossier & "/"
If Not FSO.FolderExists(sChemin) Then FSO.CreateFolder (sChemin)
Set FSO = Nothing
LeRep = Chemin & "\" & Dat1 & "\" & sNomDossier & "/" ' à adapter
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
LeRep & "HYD" & LeParcours & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=True, _
OpenAfterPublish:=True
Sheets("RAPPORT").Range("A1").Select
End Sub |
Partager