User login

Who's online

There are currently 0 users and 33 guests online.

Advertisements


SourceForge.net Logo

Simple module to create PDF easily

Submitted by Jadjay on Fri, 2008-08-08 15:09.

Copy and paste this code to new module in XLS
Keep an eye on options I modify some for personnal use!!!

Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Sub pdf_create()
' Définition des variables d'usage
Dim msg As String
Dim outName As String, i As Long, j As Integer
'répertoire par défaut
Dim rep As String
' Création de l'objet pdfCreator
Dim PDFCreator1 As PDFCreator.clsPDFCreator
Set PDFCreator1 = New clsPDFCreator
' Message si l'objet ne s'initialise pas
With PDFCreator1
If .cStart("/NoProcessingAtStartup") = False Then
msg = MsgBox("Can't initialize PDFCreator." + _
"Veuillez relancer le document", vbCritical)
Exit Sub
End If
End With
' Creation du nom du fichier pdf de type "19991231_23h59_NomFichierXLS"
If InStr(1, ActiveWorkbook.Name, ".", vbTextCompare) > 1 Then
outName = Mid( _
ActiveWorkbook.Name, _
1, _
InStr(1, _
ActiveWorkbook.Name, ".", vbTextCompare) - 1)
Else
outName = ActiveWorkbook.Name
End If
outName = Format(Date, "yyyymmdd_") + Format(Now, "Hh\hNn_") + outName
' Mise en place du répertoire par défaut
rep = ActiveWorkbook.Path
' Si vous voulez un autre répertoire que celui par défaut du document XLS
' Décommentez la ligne suivante
' rep = "C:/PDF/"
' Initialisation des propriétés du projet
With PDFCreator1
'autosave activé
.cOption("UseAutosave") = 1
'utilisation d'un répertoire par défaut
.cOption("UseAutosaveDirectory") = 1
'définition du répertoire
.cOption("AutosaveDirectory") = rep
'définition du nom
.cOption("AutosaveFilename") = outName
'type de document créé (0 = PDF)
.cOption("AutosaveFormat") = 0
'on vide le cache
.cClearCache
End With
' On sauvegarde que les pages qui ne finissent pas par "_don"
' (celles finissant par "_don" sont des feuilles de calcul inutiles au rapport)
j = 0
For i = 1 To Application.Sheets.Count
If Right(Application.Sheets(i).Name, 4) <> "_don" Then
Application.Sheets(i).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
j = j + 1
End If
Next i
' On laisse le temps à PDFCreator1 d'ajouter les feuilles
Do Until PDFCreator1.cCountOfPrintjobs = j
DoEvents
Sleep 1000
Loop
Sleep 1000
' On crée un document unique combiné
PDFCreator1.cCombineAll
Sleep 1000
' Je ne sais pas pourquoi (????) Mais il faut le faire!
PDFCreator1.cPrinterStop = False
Sleep 5000
' On détruit PDFCreator1
PDFCreator1.cClose
Set PDFCreator1 = Nothing
Sleep 250
DoEvents
' et c'est fini
End Sub

Good tips :)

© 2006 by pdfforge.org :: Contact us

Validate XHTML or CSS.