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 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
| Private Sub Imprimer_Archiver_Click()
'Save_PDF
Application.EnableEvents = False
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo EndHandler
ActiveSheet.Unprotect "CIGBB71"
If Application.Dialogs(xlDialogPrint).Show() Then
Application.EnableEvents = False
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("A1").Value _
& " ETB du " & wsA.Range("A2").Value _
'create default name for savng file
strFile = strName & Format(Now(), "dd-mm-yyyy hh.mm.ss")
strPathFile = strPath & strFile
'export to PDF in current folder
Sheets(Array("P-1", "Pyt Det", "ETB-1", "ETB-2", "ETB-3", "ETB-4", "ETB-5", "ETB-6", "ETB-7", "ETB-8", "ETB-9", "ETB-10", "COMPTABILITE")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
ignoreprintareas:=False, _
openafterpublish:=False
' Page select Macro
Sheets("P-1").Select
'confirmation message with file info
MsgBox "Un archive a été créé au format PDF : " & vbCrLf & strPathFile
Sheets("COMPTABILITE").Select
Range("BQ9:BQ19").Select
Selection.Copy
Range("BP9:BP19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("P-1").Select
Range("C4:D4").Select
Sheets("P-1").Range("G6").ClearContents
Sheets("P-1").Range("C4:D4").ClearContents
Sheets("P-1").Range("C6:D6").ClearContents
Sheets("P-1").Range("C8:D8").ClearContents
Sheets("Pyt Det").Range("PytDet_clear").ClearContents
Sheets("ETB-1").Range("ETB1_clear").ClearContents
Sheets("ETB-2").Range("ETB2_clear").ClearContents
Sheets("ETB-3").Range("ETB3_clear").ClearContents
Sheets("ETB-4").Range("ETB4_clear").ClearContents
Sheets("ETB-5").Range("ETB5_clear").ClearContents
Sheets("ETB-6").Range("ETB6_clear").ClearContents
Sheets("ETB-7").Range("ETB7_clear").ClearContents
Sheets("ETB-8").Range("ETB8_clear").ClearContents
Sheets("ETB-9").Range("ETB9_clear").ClearContents
Sheets("ETB-10").Range("ETB10_clear").ClearContents
Call Tstructuré_Actual2
Sheets("P-1").Range("G4").Value = Sheets("P-1").Range("G4").Value + 1
End If
EndHandler:
If Err <> 0 Then MsgBox "Impossible de générer l'archive (fichier PDF)"
ActiveSheet.Protect "CIGBB71", True, True, True
Application.EnableEvents = True
End Sub |
Partager