Excel VBA 的眉眉角角Day25: 控制pdf檔案產生

DAY 25

Excel VBA 的眉眉角角系列第 25 篇

鐵人賽

2014-10-17 07:29:30

12588 瀏覽

在Office2007之前，Excel或其他Office軟體，對PDF的支援幾乎是零，很無奈的，公司還是使用2003版，對於文件輸出至PDF檔，要做到自動化，似乎有點難度，好在世上有個叫pdfforge的廠商，做了一套免費的PDF虛擬印表機軟體PDFCreator，你會說，虛擬印表機，早期的CutePDF已經很好用了，為何推薦PDFCreator呢？因為，他提供了COM連接界面，也就是說，VBA可以引用PDFCreator，來達到自動化產生PDF檔的目的。PDFCreator可以修改的參數十分的多，功能十分健全，就連輸出成圖片檔、純文字檔也沒問題，但這裡暫時不討論輸出PDF以外的東西，各位可自行測試其他輸出格式。

設定選項中，有許多的選項可以使用：

在安裝好後，記得把PDFCreator引用上去，接下來，就可以來測試效果。

先將以下程式碼貼到模組最上方：

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems 帶入Sleep功能

Public Property Get clsPDFCreatorError() As PDFCreator.clsPDFCreatorError
    Set clsPDFCreatorError = New PDFCreator.clsPDFCreatorError
End Property
Public Property Get clsPDFCreator() As PDFCreator.clsPDFCreator
    Set clsPDFCreator = New PDFCreator.clsPDFCreator
End Property
Public Property Get clsPDFCreatorOptions() As PDFCreator.clsPDFCreatorOptions
    Set clsPDFCreatorOptions = New PDFCreator.clsPDFCreatorOptions
End Property

Public Declare Sub Sleep是用來帶入系統內建的Sleep函數使用。另外三個，則是PDFCreator的功能，我們先定義好，以便於使用。

下面程式為主要的列印子程式：

Function PrintSheet(SheetName As String, strPath As String, strFile As String, strStandardSubject As String, strStandardAuthor As String, strStandardTitle As String, _
                    Optional strPDFOwnerPassword As String, Optional strPDFUserPasswordString As String _
                    ) As Boolean
'變數說明
'SheetName 要列印的工作表
'strPath   存放路徑
'strFile   輸出檔名
'strStandardSubject  主題
'strStandardAuthor   作者
'strStandardTitle    標題
'strPDFOwnerPassword      擁有者密碼
'strPDFUserPasswordString 使用者密碼
'PrintSheet 回應列印成功與否
'
'更多詳細設定:
'http://www.pdfforge.org/pdfcreator/manual/com-interface-settings

PrintSheet = False

Dim strDefaultPrinterSetting As String, c As Long, OutputFilename As String

Call OpenPDFCreator

strDefaultPrinterSetting = PDFCreatorSetting '備份PDFCreator設定

With clsPDFCreator
    '.cStart "/NoProcessingAtStartup"
    '.cPrinterStop = False
    .cDefaultPrinter = "PDFCreator"   ' 變更為PDFCreator印表機
    .cClearCache
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = strPath
    .cOption("AutosaveFilename") = strFile
    .cOption("AutosaveFormat") = 0 ' 0 = PDF
    .cOption("UseStandardAuthor") = 1
    .cOption("StandardAuthor") = strStandardAuthor
    .cOption("StandardTitle") = strStandardTitle
    .cOption("StandardSubject") = strStandardSubject
    .cOption("ShowAnimation") = 0
    .cOption("PDFAes128Encryption ") = 1
    .cOption("PDFUseSecurity") = 1
    
    '有密碼就設定上去,但目前有BUG
    '有密碼的狀態下,中繼資料的字串無法正常呈現
    If strPDFOwnerPassword <> "" Then
        .cOption("PDFOwnerPass") = 1
        .cOption("PDFOwnerPasswordString") = strPDFOwnerPassword
    End If
    If strUserPassword <> "" Then
        .cOption("PDFUserPass") = 1
        .cOption("PDFUserPasswordString") = strPDFUserPasswordString
    End If
    
    Sheets(SheetName).PrintOut  '列印指定的工作表
    
    Do Until .cCountOfPrintjobs = 1
        DoEvents
        If Len(Dir(strPath & strFile)) > 0 Or Len(Dir(strPath & strFile & ".pdf")) > 0 Then
            PrintSheet = True
            Exit Do
        End If
    Loop

End With

Call PDFCreatorSetting(strDefaultPrinterSetting) '復原PDFCreator設定

End Function

以下程式用於開啟PDFCreator：

Sub OpenPDFCreator()

If clsPDFCreator.cProgramIsRunning = False Then
    With clsPDFCreator
        .cStart "/NoProcessingAtStartup"
        .cPrinterStop = False
    End With
    Sleep 1000
End If

End Sub

以下程式，用來備份與回寫設定，以避免user之前的設定亂掉

Function PDFCreatorSetting(Optional strRestore As String) As String

Call OpenPDFCreator '要開啟PDFCreator程式才能正常收集到資料
clsPDFCreator.cClearCache

If strRestore = "" Then
    Dim strTemp As String
    Dim strBackup() As String
    ReDim strBackup(19)
    
    strBackup(1) = clsPDFCreator.cDefaultPrinter
    strBackup(2) = clsPDFCreator.cOption("UseAutosave")
    strBackup(3) = clsPDFCreator.cOption("UseAutosaveDirectory")
    strBackup(4) = clsPDFCreator.cOption("AutosaveDirectory")
    strBackup(5) = clsPDFCreator.cOption("AutosaveFilename")
    strBackup(6) = clsPDFCreator.cOption("AutosaveFormat")
    strBackup(7) = clsPDFCreator.cOption("UseStandardAuthor")
    strBackup(8) = clsPDFCreator.cOption("StandardAuthor")
    strBackup(9) = clsPDFCreator.cOption("StandardTitle")
    strBackup(10) = clsPDFCreator.cOption("StandardSubject")
    strBackup(11) = clsPDFCreator.cOption("ShowAnimation")
    strBackup(12) = clsPDFCreator.cOption("PDFAes128Encryption ")
    strBackup(13) = clsPDFCreator.cOption("PDFUseSecurity")
    strBackup(14) = clsPDFCreator.cOption("PDFUserPass")
    strBackup(15) = clsPDFCreator.cOption("PDFUserPasswordString")
    strBackup(16) = clsPDFCreator.cOption("PDFOwnerPass")
    strBackup(17) = clsPDFCreator.cOption("PDFOwnerPasswordString")
    strBackup(18) = clsPDFCreator.cOption("RequireUserPassword")
    strBackup(19) = clsPDFCreator.cOption("UserPassword")
    
    For i = 1 To 19
        If strTemp = "" Then
            strTemp = strBackup(i)
        Else
            strTemp = strTemp & vbTab & strBackup(i)
        End If
    Next
    PDFCreatorSetting = strTemp
Else
    tmp = Split(strRestore, vbTab)
    clsPDFCreator.cDefaultPrinter = tmp(0)
    clsPDFCreator.cOption("UseAutosave") = tmp(1)
    clsPDFCreator.cOption("UseAutosaveDirectory") = tmp(2)
    clsPDFCreator.cOption("AutosaveDirectory") = tmp(3)
    clsPDFCreator.cOption("AutosaveFilename") = tmp(4)
    clsPDFCreator.cOption("AutosaveFormat") = tmp(5)
    clsPDFCreator.cOption("UseStandardAuthor") = tmp(6)
    clsPDFCreator.cOption("StandardAuthor") = tmp(7)
    clsPDFCreator.cOption("StandardTitle") = tmp(8)
    clsPDFCreator.cOption("StandardSubject") = tmp(9)
    clsPDFCreator.cOption("ShowAnimation") = tmp(10)
    clsPDFCreator.cOption("PDFAes128Encryption ") = tmp(11)
    clsPDFCreator.cOption("PDFUseSecurity") = tmp(12)
    clsPDFCreator.cOption("PDFUserPass") = tmp(13)
    clsPDFCreator.cOption("PDFUserPasswordString") = tmp(14)
    clsPDFCreator.cOption("PDFOwnerPass") = tmp(15)
    clsPDFCreator.cOption("PDFOwnerPasswordString") = tmp(16)
    clsPDFCreator.cOption("RequireUserPassword") = tmp(17)
    clsPDFCreator.cOption("UserPassword") = tmp(18)
End If

End Function

以下為呼叫列印的程式：

Sub Day25_PDFCreator_PrintSheet_test()
    Sheets("Day25").Select
    For iCol = 2 To 3
        Debug.Print PrintSheet(Cells(2, iCol), Cells(3, iCol), Cells(4, iCol), Cells(5, iCol), Cells(6, iCol), Cells(7, iCol), Cells(8, iCol), Cells(9, iCol))
    Next
End Sub

例如我們有以下資料：