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 66 67
| Sub Fermer_Classeur_avec_PDF()
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name <> "" Then Feuille.Protect "TOTO", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowSorting:=True
Next
Dim Rep As Long, sFichier As String
Dim FSO As Object
Rep = MsgBox("Voulez-vous sauvegarder avec les onglets en pdf ?", vbYesNo)
If Rep = vbYes Then
Set FSO = CreateObject("Scripting.FileSystemObject")
sFichier = ThisWorkbook.Path & "\" & FSO.GetBaseName(ThisWorkbook.Name) & ".pdf"
If FSO.FileExists(sFichier) Then
Rep = MsgBox("Le fichier PDF existe déjà, confirmer son écrasement ?", vbYesNo)
If Rep = vbYes Then SavePDF sFichier
Else
SavePDF sFichier
End If
Set FSO = Nothing
End If
End Sub
Private Sub SavePDF(sNomFichier As String)
' Pour choisir les onglet en PDF
Dim Ar(1) As String
Ar(0) = "titi"
Ar(1) = "tata"
Application.ScreenUpdating = False
Sheets(Ar).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sNomFichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
'Permer de ranger les cellule par defaut sur chaque onglet
Sheets("tata").Select
Range("B1").Select
Sheets("titi").Select
Range("C1").Select
Sheets("titi").Visible = True
Sheets("tata").Visible = True
Sheets("toto").Visible = False
ActiveWorkbook.Save 'Fermeture Avec sauvegarde
CancelSortie = False 'reactive la croix de fermeture
ActiveWorkbook.Close
End Sub |
Partager