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
| Option Explicit
Sub Tst()
Dim sNomFichierPDF As String
Dim i As Long, j As Long, Cpt As Long
Dim Ar() As String, Tablo() As Variant
Dim FSO As Object, sNom As String
Tablo = Array("Entête PV", "Pesées RI", "Pesées RI", "Pesées FI", "Filtres", "Absorption 1", "Absorption 2", "Rinçages")
Set FSO = CreateObject("Scripting.FileSystemObject")
sNom = FSO.GetBaseName(ThisWorkbook.Name)
Set FSO = Nothing
sNomFichierPDF = ThisWorkbook.Path & "\" & sNom & ".pdf"
Cpt = 0
Erase Ar
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Cells(1, 1) <> "" Then
For j = LBound(Tablo) To UBound(Tablo)
If Sheets(i).Name = Tablo(j) Then
ReDim Preserve Ar(Cpt)
Ar(Cpt) = Sheets(i).Name
Cpt = Cpt + 1
Exit For
End If
Next j
End If
Next i
If Cpt = 0 Then
MsgBox "Aucune feuille n'a été sélectionnée !"
Exit Sub
End If
Application.ScreenUpdating = False
Sheets(Ar).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sNomFichierPDF, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Feuil1.Select
Application.ScreenUpdating = True
End Sub |
Partager