关于大家有没有用 VBA做过word打印到pdf文件的程序的问题。

Question

配置x:\WINNT\system32\spool\drivers\w32x86\_PDF.INT
或写注册表.
adobe的网站上有文档.

Answer 1

给个例子，如果用Acrobat Distiller，不用修改注册表。Option ExplicitPrivate Const DE_TIME_OUT As String = "Time out. "
Private Const DE_WORD As String = "OpusApp" 'word97
Private Const WM_CLOSE = &H10Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPublic Function Doc2PDF(OriginalFile As String, PDFFileName As String) As Boolean
On Error GoTo has_err
    Dim objWord  As Word.Application
    Dim objDocument As Word.Document
    Dim startTime As Single
    Dim oldPrinter As String
    Dim PrintOutFileName As String
    Dim PdfDis As ACRODISTXLib.PdfDistiller
    Dim i As Integer
    Const inches As Single = 0.25
    
    PrintOutFileName = Replace(PDFFileName, ".pdf", ".prn")
    DeleteLocalFile PrintOutFileName    Set objWord = CreateObject("Word.Application")
    Set objDocument = objWord.Documents.Open(OriginalFile, False, True)
        oldPrinter = objWord.ActivePrinter
        objDocument.PageSetup.TopMargin = objWord.InchesToPoints(inches)
        objDocument.PageSetup.LeftMargin = objWord.InchesToPoints(inches)
        objDocument.PageSetup.BottomMargin = objWord.InchesToPoints(inches)
        objDocument.PageSetup.RightMargin = objWord.InchesToPoints(inches)
        startTime = Timer
        objWord.ActivePrinter = "Acrobat Distiller"
        objWord.PrintOut Background:=False, Append:=False, Range:=wdPrintAllDocument, OutputFileName:=PrintOutFileName, Copies:=1, PageType:=wdPrintAllPages, PrintTOFile:=True, Collate:=True, FileName:=OriginalFile, ManualDuplexPrint:=False
        
        If Not (objWord Is Nothing) Then
            objWord.ActivePrinter = oldPrinter
            objDocument.Close Savechanges:=wdDoNotSaveChanges
            objWord.Quit False
        End If
        Set objDocument = Nothing
        Set objWord = Nothing
        
        startTime = Timer
        Do While Dir(PrintOutFileName) = ""
            If Timer > startTime + 15 Then
                mvarErrMessage = DE_TIME_OUT & " when print out to file"
                Doc2PDF = False
                Exit Do
            Else
                DoEvents
            End If
        Loop
        If mvarErrMessage <> DE_TIME_OUT Then
            Set PdfDis = New ACRODISTXLib.PdfDistiller
            i = PdfDis.FileToPDF(PrintOutFileName, PDFFileName, "")
            startTime = Timer
            Do While Dir(PDFFileName) = ""
                If Timer > startTime + 10 Then
                    mvarErrMessage = DE_TIME_OUT
                    Doc2PDF = False
                    Set PdfDis = Nothing
                    Exit Function
                Else
                    DoEvents
                End If
            Loop
            DeleteLocalFile PrintOutFileName
            Doc2PDF = True
            Set PdfDis = Nothing
        End If
has_err:
    If Err.Number <> 0 Then
        Doc2PDF = False
        mvarErrMessage = Err.Description & ", " & Err.Source & ", " & Err.Number
        CloseWindow (DE_WORD)
        Set objDocument = Nothing
        Set objWord = Nothing
        Exit Function
    End If
    If Not (objWord Is Nothing) Then
        objWord.ActivePrinter = oldPrinter
        objDocument.Close Savechanges:=wdDoNotSaveChanges
        objWord.Quit False
    End If
        Set objDocument = Nothing
        Set objWord = Nothing
End FunctionPrivate Sub CloseWindow(ProcessClass)
    Dim ret As Long
    ret = FindWindow(ProcessClass, vbNullString)
    If ret <> 0 Then
        PostMessage ret, WM_CLOSE, 0, 0
    End If
End Sub