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 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
| Private Sub CommandBtCreerImage_Click()
Dim nomfichier, rep, repdate, corpsmessage, oldprinter As String
Dim PDFCreator1 As PDFCreator.clsPDFCreator
Dim FichierSource, FichierDestination
oldprinter = ActivePrinter 'On va mettre en mémoire dans une variable le nom de l'imprimante par défaut
rep = "C:\Documents and Settings\gregoire\Mes documents\Divers\PlanningPersonnel"
repdate = rep & "\" & Format(Now, "yyyymmdd")
If Dir(repdate, vbDirectory) = "" Then
MkDir repdate 'on crée le répertoire s'il n'existe pas...
Else
'MsgBox "Le répertoire existe"
End If
ActiveWorkbook.Worksheets("Planning Journalier").Range("F2").Value = ""
'ActiveWorkbook.Worksheets("Planning Journalier").PageSetup.PrintArea = Range("A2:V34").Address
With ActiveWorkbook.Worksheets("Planning Journalier").PageSetup
'Définit la zone d'impression pour une plage de cellules.
.PrintArea = Range("A2:V34").Address
'Mise en page: définit les marges
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.5)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Zoom = False
.FitToPagesWide = 1 'adapter la zone d'impression à une seule feuille
.FitToPagesTall = 1 'adapter la zone d'impression à une seule feuille
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape 'xlPortrait
.PaperSize = xlPaperA3 'xlPaperUser 'xlPaperA3
End With
Set PDFCreator1 = New PDFCreator.clsPDFCreator
If PDFCreator1.cStart("/NoProcessingAtStartup") = False Then
'creation d'un fichier de log
End If
nomfichier = "PlanningRoto_" & Format(Now, "yyyy-mm-dd") & ".jpg"
With PDFCreator1
.cVisible = True
If .cStart("/NoProcessingAtStartup") = False Then
If .cStart("/NoProcessingAtStartup", True) = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
' L'imprimante est occupée
.cVisible = True
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutoSaveDirectory") = repdate
.cOption("AutoSaveFilename") = nomfichier
.cOption("AutosaveFormat") = 2 ' 0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
.cOption("PDFGeneralAutorotate") = 0
.cClearCache
.cDefaultPrinter = "PDFCreator"
End With
ActiveWorkbook.Worksheets("Planning Journalier").PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until PDFCreator1.cCountOfPrintjobs = 1
DoEvents
Sleep 1000
Loop
PDFCreator1.cPrinterStop = False
Do Until PDFCreator1.cCountOfPrintjobs < 1
DoEvents
Sleep 1000
Loop
'on fait une copie de l'image qu'on vient de créer
FichierSource = repdate & "\" & nomfichier
FichierDestination = rep & "\PlanningRoto.jpg"
'MsgBox (FichierSource & " -> " & FichierDestination)
FileCopy FichierSource, FichierDestination
ActiveWorkbook.Worksheets("Planning Journalier").Range("F2").Value = ""
'ActiveWorkbook.Worksheets("Planning Journalier").PageSetup.PrintArea = Range("A35:V94").Address
With ActiveWorkbook.Worksheets("Planning Journalier").PageSetup
'Définit la zone d'impression pour une plage de cellules.
.PrintArea = Range("A35:V94").Address
'Mise en page: définit les marges
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.5)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.Zoom = False
.FitToPagesWide = 1 'adapter la zone d'impression à une seule feuille
.FitToPagesTall = 1 'adapter la zone d'impression à une seule feuille
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape 'xlPortrait
.PaperSize = xlPaperA3 'xlPaperUser (420, 360) 'xlPaperA3
End With
'Set PDFCreator1 = New PDFCreator.clsPDFCreator
If PDFCreator1.cStart("/NoProcessingAtStartup") = False Then
'creation d'un fichier de log
End If
nomfichier = "PlanningCF_" & Format(Now, "yyyy-mm-dd") & ".jpg"
With PDFCreator1
.cVisible = True
If .cStart("/NoProcessingAtStartup") = False Then
If .cStart("/NoProcessingAtStartup", True) = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
' L'imprimante est occupée
.cVisible = True
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutoSaveDirectory") = repdate
.cOption("AutoSaveFilename") = nomfichier
.cOption("AutosaveFormat") = 2 ' 0 = PDF
.cOption("AutoRotate") = 0
.cClearCache
.cDefaultPrinter = "PDFCreator"
End With
ActiveWorkbook.Worksheets("Planning Journalier").PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until PDFCreator1.cCountOfPrintjobs = 1
DoEvents
Sleep 1000
Loop
PDFCreator1.cPrinterStop = False
Do Until PDFCreator1.cCountOfPrintjobs < 1
DoEvents
Sleep 1000
Loop
'on fait une copie de l'image qu'on vient de créer
FichierSource = repdate & "\" & nomfichier
FichierDestination = rep & "\PlanningCF.jpg"
FileCopy FichierSource, FichierDestination
PDFCreator1.cClose
'MsgBox (oldprinter)
ActivePrinter = oldprinter ' Change l'imprimante par défaut
End Sub |
Partager