Générer un document pdf à partir d'un document doc

Commenter

Contenu du snippet

Attention, cette source necessite l'installation préalable d'Acrobat Writer !
Elle est adapté ici à Word, mais éventuellement toute application capable d'imprimer est susceptible d'être pilotée ainsi.
Bien sûr, vos propres applis vb peuvent imprimer en PDF de la même manière.
Pour que le code fonctionne correctement tel quel, il faut rajouter les référence à l'application Word dans le projet.

Source / Exemple : 


Option Explicit

'Fonction qui permet de spécifier le fichier de sortie PDF
Private Declare Function PDFMonSetOutputFilename Lib "C:\Program Files\Adobe\Acrobat 4.0\Macros\Office95\PDFMon.dll" (ByVal FileName As String) As Long
'Fonction qui détecte la présence d'un PDF Writer
Private Declare Function IsPDFWriterInstalled Lib "C:\Program Files\Adobe\Acrobat 4.0\Macros\Office95\PDFMon.dll" (ByVal PDFWriterName As String, ByVal Port As String) As Long
'nettoyage de la mémoire après l'utilisation des librairies PDF
Private Declare Sub PDFMonCleanup Lib "C:\Program Files\Adobe\Acrobat 4.0\Macros\Office95\PDFMon.dll" ()

Private WordApp As Word.Application
Private Document As Word.Document

Sub CloseWord()
    Dim Doc As Word.Document
    'on ferme tous les documents ouverts
    For Each Doc In WordApp.Documents
        Doc.Close False
    Next
    Set Document = Nothing
    'on quitte word
    WordApp.Quit
End Sub

'Cas où on créé un fichier de toutes pièces
' ce cas sera utilisé si un utilisateur selectionne plusieurs informations en même temps
Sub CreateFile()
    Set WordApp = CreateObject("Word.application")
    Set Document = WordApp.Documents.Add
    
End Sub

'Ajoute un fichier à la fin du fichier courant
Sub AppendFile(FileName As String)
    Dim FileRange As Word.Range
    Set FileRange = Document.Range
    FileRange.Collapse wdCollapseEnd
    FileRange.InsertFile FileName, , False
End Sub

'cas où on trsforme un fichier complet, comme un document de synthèse
Sub OpenFile(FileName As String)
    Set WordApp = CreateObject("Word.application")
    Set Document = WordApp.Documents.Open(FileName, False, , False)
End Sub

'Génère le document PDF
' OutputFileName est le nom du fichier généré
Sub Doc2Pdf(OutputFileName As String)
    'on met à jour les champs du document
    'dans le corps
    Document.Fields.Update
    Dim Section As Word.Section, HeaderFooter As Word.HeaderFooter
    
    'dans les pieds de pages et les en-têtes
    For Each Section In Document.Sections
        On Error Resume Next
        For Each HeaderFooter In Section.Headers
            HeaderFooter.Range.Fields.Update
        Next
        For Each HeaderFooter In Section.Footers
            HeaderFooter.Range.Fields.Update
        Next
    Next
    'Dans les zones de texte flottantes
    Dim Shape As Word.Shape
    For Each Shape In Document.Shapes
        Shape.Select
        WordApp.Selection.Range.Fields.Update
    Next
    Err.Clear

    'Ces deux lignes sont nécessaires car sinon
    'il y a des pblms aléatoires dû au rafraichissement d'écran
    WordApp.Visible = False
    WordApp.ScreenUpdating = False
    'Définition de l'imprimante par défaut
    On Error GoTo 0
    Dim PDFWriterName As String, Port As String
    If EnsurePDFWriterIsInstalled(PDFWriterName, Port) Then
        Document.Activate
        'On indique à word d'utiliser l'imprimante Abcrobat distiller
        WordApp.ActivePrinter = PDFWriterName
        'on lui impose ensuite le nom de fichier
        PDFMonSetOutputFilename OutputFileName
        'Impression vers l'imprimante distiller
        WordApp.PrintOut
        'on nettoye le mémoire derrière nous
        'PDFMonCleanup
    End If
End Sub

'vérification de la présence d'acrobat sur la machine
'fonctions fournies par adobe
'modifiée par Olivier marty
Private Function EnsurePDFWriterIsInstalled(PDFWriterName As String, Port As String) As Boolean
    Dim found, starPos

    On Error GoTo -1: On Error GoTo EnsurePDFWriterIsInstalledError
    EnsurePDFWriterIsInstalled = False

    PDFWriterName = String(100, "*")
    Port = String(100, "*")

    found = IsPDFWriterInstalled(PDFWriterName, Port)
    If (found = 1) Then
        EnsurePDFWriterIsInstalled = True
        starPos = InStr(PDFWriterName, "*")
        PDFWriterName = Left$(PDFWriterName, starPos - 2)
        starPos = InStr(Port$, "*")
        Port = Left$(Port, starPos - 2)
    End If

EnsurePDFWriterIsInstalledError:

End Function

Conclusion :


Les fonctions PDF sont importantes si vous souhaiter ne plus afficher les boite de dialogue qui demande le nom des fichiers à ecrire.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Warny)