使用vba + 開源函式庫,解決excel 另存pdf 無法加密問題(vba範例)

(***此文只在mobile01發表,如轉貼到其它論譠、blog,請附上來源網址,謝謝***)

office 有內建的另存pdf功能,word 可存加密的pdf
而excel雖然有加密選項,可是不能選
想存加密的excel pdf,就要裝acrobat,使用列印功能來存檔
或用其它pdf編輯軟體,把未加密的pdf加上密碼
但這樣沒辦一氣呵成,有點麻煩

照慣例先google,找不到相關範例
所以寫一個使用開源函式庫的範例,讓大家參考

範例功能:
可替pdf加上128-bit RC4密碼,不需要另外裝acrobat(或其它編輯軟體)
只需要幾行程式碼就可簡單加上密碼

前置作業
一、至少要有 .net framework 4.0 (或以上)
二、把附件中的ProtectPDF.dll,放到c:\windows\ (或您喜歡的位置)
三、登錄程式庫,使用系統管理員權限執行命令提示字元(cmd)
這裡要注意一下32、64位元,不要選錯目錄

32位元 excel(需先關閉excel)
進入目錄 C:\Windows\Microsoft.NET\Framework\v4???????
執行
RegAsm.exe c:\windows\ProtectPDF.dll /tlb: ProtectPDF32.tlb /codebase

64位元 excel(需先關閉excel)
進入目錄 C:\Windows\Microsoft.NET\Framework64\v4??????
執行
RegAsm.exe c:\windows\ProtectPDF.dll /tlb: ProtectPDF64.tlb /codebase

(如果想移除程式庫註冊,先關閉excel,最後加上unregister,像這樣 ... /codebase /unregister )

四、打開excel,進入visual basic
=>工具=>設定引用項目=>瀏覽=>選 ProtectPDF32.tlb 或 ProtectPDF64.tlb

五、把程式碼放到模組裡



'===========================
'範例執行效果
'把目前的活頁薄在桌面上存一個沒密碼的pdf
'使用程式庫加上唯讀、可讀寫密碼,另存一個加密pdf
'使用複製程式碼方式自建檔案的,請把<>全形,改成半形字


Sub Savepdf()


Dim Report As String, target As String, ReadOnlyPassWord As String, EditPassWord As String, SetPassWord As Object
Set SetPassWord = CreateObject("ProtectPDF.GoPDF")

'設定檔名、目錄、密碼
target = Environ("USERPROFILE") & "\Desktop\"
filename1 = target & "nopassword.pdf"
filename2 = target & "password.pdf"
ReadOnlyPassWord = "123"
EditPassWord = "456"

'另存新檔pdf格式
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filename1, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'加入密碼保護
Report = SetPassWord.protectpdfstandard(ReadOnlyPassWord, EditPassWord, filename1, filename2)

'Debug.Print Report
Set SetPassWord = Nothing
End Sub

'===============================

這個副程式,可以很容易的改自動化,想處理大量檔案也沒問題(像員工薪資表之類的)
之後,就看您們要如何使用、改寫了
附加壓縮檔: 201706/mobile01-a715ac672b3ed9fcd4a15138090eed9a.zip



'==2017/7/9 不想讓文章浮上來,反正也沒人看,偷偷增加一個範例 ==
'===內有vlookup 搜尋array+錯誤處理方式====
'===2017/7/16 小小修改一下autopdf副程式 ===


'程式功能,使用A欄的資料(不用排序),分類後,新增工作表,再分別另存pdf(加密)


Sub autopdf()

Dim i As Integer, Password_Data As Variant, AllCriteria, Criteriadata, report, checkname As String, target1 As String, target2 As String, target3 As String


target1 = "c:\excel\" '暫存目錄1
target2 = "c:\excel\password\" '暫存目錄2
target3 = "c:\excel\nopassword\" '暫存目錄3

Call delsheet
Call deltemp(target1, target2, target3)

Application.ScreenUpdating = False


With Sheets("sheet1")
.Select
.Range("a:a").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set AllCriteria = .Range(.Cells(2, "a"), .Cells(2, "a").End(xlDown)).SpecialCells(xlCellTypeVisible)
Password_Data = Sheets("密碼表").Range("a2:c" & Sheets("密碼表").Range("a1").CurrentRegion.Rows.Count)

For Each Criteriadata In AllCriteria

report = Application.VLookup(Criteriadata, Password_Data, 1, False)

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "_" & Criteriadata & "_"
.Range("a:a").AutoFilter Field:=1, Criteria1:=Criteriadata
.UsedRange.Copy Sheets("_" & Criteriadata & "_").Cells(1, 1)

If TypeName(report) = "Error" Then
checkname = checkname & vbNewLine & Criteriadata
readonlypassword = ""
editpassword = ""
Else
readonlypassword = Application.VLookup(Criteriadata, Password_Data, 2, False)
editpassword = Application.VLookup(Criteriadata, Password_Data, 3, False)
End If

'Debug.Print criteriadata & "_" & ReadOnlyPassWord & "_" & EditPassWord
Call Savepdf(target2, target3, Criteriadata, readonlypassword, editpassword)

Next

.AutoFilterMode = False

End With

'call delsheet

Worksheets(1).Select
Application.ScreenUpdating = True

If checkname <> "" Then
MsgBox "以下資料不在密碼表內,不會加入密碼保護" & checkname, vbOKOnly, "資料比對錯誤"
End If


Shell "explorer.exe" & " " & target1, vbNormalFocus

End Sub


Sub Savepdf(target2 As String, target3 As String, filename, readonlypassword, editpassword)


Dim report As String, SetPassWord As Object
Set SetPassWord = CreateObject("ProtectPDF.GoPDF")

'另存新檔pdf格式
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=target3 & filename, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

'加入密碼保護
report = SetPassWord.protectpdfstandard(readonlypassword, editpassword, target3 & filename & ".pdf", target2 & filename & ".pdf")

Set SetPassWord = Nothing


End Sub

Sub delsheet()

Application.DisplayAlerts = False

Dim delsheet() As Variant, Protect() As Variant
ReDim delsheet(1 To Worksheets.Count)
Protect = Array("Sheet1", "我要留著", "不能刪的", "密碼表")
'可自訂不想刪的工作表名稱

For i = 1 To Worksheets.Count
If Join(Filter(Protect, Worksheets(i).Name)) = "" Then
j = j + 1
delsheet(j) = Worksheets(i).Name
End If
Next

If j = "" Then Exit Sub

ReDim Preserve delsheet(1 To j)
Worksheets(delsheet).Delete
Worksheets(1).Select
Application.DisplayAlerts = True


End Sub

Sub deltemp(target1 As String, target2 As String, target3 As String)

If Dir(target1, vbDirectory) = "" Then MkDir target1
If Dir(target2, vbDirectory) = "" Then MkDir target2
If Dir(target3, vbDirectory) = "" Then MkDir target3

'注意,暫存目錄下的檔案(含子目錄),會在無任何提示下刪除

If Dir(target1 & "*.*") <> "" Then Kill target1 & "*.*"
If Dir(target2 & "*.*") <> "" Then Kill target2 & "*.*"
If Dir(target3 & "*.*") <> "" Then Kill target3 & "*.*"

End Sub

'=============================================================


這是(64位元 excel 範例),如果要用32位元的 excel ,請重新設定32位元的引用項目

附加壓縮檔: 201707/mobile01-a822b9e8c4c84d5206deb1b8f8465fa0.zip
2017-06-26 1:20 #1
大大您好~
當我在註冊RegAsm時,出現了以下的錯誤訊息~請問該如何處理呢?感謝~

============================================================
C:\Windows\Microsoft.NET\Framework\v4.0.30319>RegAsm.exe c:\windows\ProtectPDF.dll /tlb: ProtectPDF64.tlb /codebase
Microsoft .NET Framework Assembly Registration Utility 版本 4.6.1586.0
for Microsoft .NET Framework 版本 4.6.1586.0
Copyright (C) Microsoft Corporation. 著作權所有,並保留一切權利。

RegAsm : warning RA0000 : 使用 /codebase 選項註冊一個 unsigned 組件,您的組件可能會和安裝在同一部電腦上的其他應用程式相 衝突。/codebase 選項通常只用在已簽署的組件。請以強式名稱命名您的組件並重新註冊。
已成功註冊類型
組件已匯出到 'c:\windows\ProtectPDF64.tlb',而且類型程式庫已成功登錄

C:\Windows\Microsoft.NET\Framework\v4.0.30319>
=================================================================

我猜,進而也導致VBA,執行到「Set SetPassWord = CreateObject("ProtectPDF.GoPDF")」時,出現錯誤訊息,如下圖:


chl0924 wrote:
出現錯誤訊息,如下圖:...(恕刪)


那個錯誤不用管它,最後有出現成功就可以了

您大概是忘記設定引用項目
(32位元excel 需重新把引用項目設定成ProtectPDF32.tlb)
或是在excel打開(需先關閉)的狀態下執行 regasm

ProtectPDF.dll,請使用第一個附件中的檔案,不要自己去網路上下載

移除 tlb




重新註冊 tlb

感謝樓主!
剛好需要幫老闆做這個自動化跑加密薪資單
原本要用C#另外寫
剛好看到這篇神文
這樣就可以一氣呵成了
感謝樓主~~~
幫助了我這個臨危受命的門外漢(跪)
您好

謝謝 真的很厲害
程序的執行也沒問題

謝謝您
chl0924 wrote:
大大您好~當我在註冊RegAsm...(恕刪)


掛ProtectPDF喔.....
我目前都用 EPPlus 程式輸出 excel跟讀取,
也可以轉 PDF,加密偶就不知到了⋯⋯
限制級
您即將進入之討論頁 需滿18歲 方可瀏覽。
提醒:內容可能因過於寫實、驚悚而令人感到不舒服,是否繼續觀看?

根據「電腦網路內容分級處理辦法」修正條文第六條第三款規定,已於該限制級網頁,依台灣網站分級推廣基金會規定作標示。
評分
複製連結