EXCEL VBA批量添加多个PDF文件文本水印

bluesky_0

我今天改善我们公司银行水单批量处理工作,
想实现银行水单批量把每一个水单对应的各自的会计凭证号码做成水印,印在pdf文件上
搜了一天案例都不甚理想,下午终于.......
找到这个文章(http://club.excelhome.net/thread-1238655-1-1.html),受其启发,找到 adobe公司论坛,
get了操作PDF水印专用函数:addWaterMarkFromText
(函数完整参数说明见PDF API用户手册272页:
手册下载地址  https://www.adobe.com/content/da ... s_api_reference.pdf)

下面是添加水印范本:(注意不支持中文水印,暂时我没有解决这个问题)
Sub pdfwatermark()
'添加PDF水印
Dim pdApp As Acrobat.AcroApp
Dim pdDoc As Acrobat.AcroPDDoc
Dim pdPage As Acrobat.AcroPDPage
Dim jso As Object

Set pdApp = CreateObject("AcroExch.App")
Set pdDoc = CreateObject("AcroExch.PDDoc")
pdDoc.Open ("D:\160.pdf") '这里加个循环变量就可以实现动态的打开指定的pdf文件
Set jso = pdDoc.GetJSObject

下面这个用法是添加系统日期时间,带各种水印参数:
Call jso.addWaterMarkFromText(Date, jso.app.Constants.Align.Center, jso.Font.Helv, 16, jso.Color.Black, 0, 0, True, True, True, jso.app.Constants.Align.Center, jso.app.Constants.Align.Center, 100, 100, False, 1, False, 0, 1)

下面这个用法是添加字符水印(watermarks TEST),带各种水印参数:
Call jso.addWaterMarkFromText("watermarks TEST", jso.app.Constants.Align.Center, jso.Font.Helv, 20, jso.Color.Black, 0, 0, True, True, True, jso.app.Constants.Align.Center, jso.app.Constants.Align.Center, 0, 0, False, 1, False, 45, 1)

下面这个用法是 加字符水印(AP-100),水印系统参数全部使用系统默认的:
jso.addWaterMarkFromText ("AP-100")

pdDoc.Save 1, "D:\160.pdf"   '这里可以是不同于打开的pdf文件名,相当于另存为;如果是和打开的pdf文件名相同,自动保存不提示
pdDoc.Close
Set pdDoc = Nothing
Set pdApp = Nothing

End Sub

bluesky_0

PDF水印函数参数.rar (10.77 KB, 下载次数: 178)

2020-10-14 20:08 上传

点击文件名下载附件

补上 水印参数中文说明

PDF水印函数参数说明

lizhipei78

如何使用呢？

bluesky_0

lizhipei78 发表于 2020-10-17 20:28
如何使用呢？

我都贴出VBA代码了.使用那个代码就行了

opiona

在楼主启发下  整理了一下  写成了函数

只加了几个参数,  如果需要其他参数  可以自己加上去

1. 
   
2. Sub TEST()
   
3.     Dim Path, PathB, StrX As String
   
4.     Dim IntAngle, IntFont As Integer
   
5.     Dim DouZoom, DouTSC As Double
   
6.     Path = ThisWorkbook.Path & "\1.pdf"
   
7.     PathB = ThisWorkbook.Path & "\4.pdf"
   
8.     StrX = "Watermarks TEST"
   
9.    
   
10.     IntFont = 40
    
11.     IntAngle = 30
    
12.     DouZoom = 1.5
    
13.     DouTSC = 0.3
    
14.     Call PDFWatermark(Path:=Path, StrX:=StrX, PathB:=PathB, IntFont:=IntFont, DouZoom:=DouZoom, IntAngle:=IntAngle, DouTSC:=DouTSC)
    
15. End Sub
    
16. 
    
17. Sub PDFWatermark(ByVal Path As String, ByVal StrX As String, Optional ByVal PathB As String = "", Optional ByVal IntFont As Integer = 20, Optional ByVal DouZoom As Double = 1, Optional ByVal IntAngle As Integer = 45, Optional ByVal DouTSC As Double = 0.3)
    
18.     Rem 添加PDF水印
    
19.     Rem Path           原始PDF文件全路径
    
20.     Rem StrX            水印文字;  参数1: 水印内容,换行使用 \r     好像汉字会乱码
    
21.     Rem PathB         保存PDF文件全路径
    
22.      Rem IntFont      字体大小=20;   参数4: 字体大小
    
23.     Rem DouZoom  显示倍数=1;    参数16: 水印的比例，其中1.0是100%。-1指定水印应适合于页面，同时保持其比例。默认值是1
    
24.     Rem IntAngle     旋转度数=45;  参数18: 逆时针旋转度数,默认0
    
25.     Rem DouTSC      透明度数=0.3;  参数19: 水印是否(0,1)透明,默认1不透明
    
26.    
    
27.     Rem  引用:    Adobe Acrobat X.0 Type Library  和 AcroBrokerLib
    
28.     Rem  Call PDFWatermark(Path, StrX, PathB)
    
29.    
    
30.     Rem 下面这个用法是 加字符水印(AP - 100), 水印系统参数全部使用系统默认的:
    
31.     Rem  jso.addWaterMarkFromText ("AP-100")
    
32.    
    
33.     Rem 下面这个用法是添加字符水印(watermarks TEST),带各种水印参数:
    
34.     Rem 1=文本,2=对齐,3=字体,4=字体大小
    
35.     Rem 5=颜色,6=开始页,7=结束页,8=真值在水印上
    
36.     Rem 9=屏幕显示水印,10=打印时有水印,11=水印水平位置,12=水印垂直位置
    
37.     Rem 13=水平位移值,或百分比,14=垂直位移值,或百分比,15=位移适用百分比,16=显示倍数
    
38.     Rem 17=保持水印自身大小,18=角度,19=透明度或灰度
    
39.    
    
40.     Dim pdApp As Acrobat.AcroApp
    
41.     Dim pdDoc As Acrobat.AcroPDDoc
    
42.     Dim pdPage As Acrobat.AcroPDPage
    
43.     Dim jso As Object
    
44.     Dim IntPageCount, IntStarPage, IntEndPage As Integer   '//页码
    
45.    
    
46.     Set pdApp = CreateObject("AcroExch.App")
    
47.     Set pdDoc = CreateObject("AcroExch.PDDoc")
    
48.     pdDoc.Open (Path) '这里加个循环变量就可以实现动态的打开指定的pdf文件
    
49.     Set jso = pdDoc.GetJSObject
    
50.    
    
51.     IntPageCount = pdDoc.GetNumPages   '//页码总数量
    
52.     IntStarPage = 0       '//参数:6=开始页 第一页从0 开始
    
53.     IntEndPage = IntPageCount - 1    '//参数:7=结束页  从0 开始  所以 -1
    
54. 
    
55.     Call jso.addWaterMarkFromText(StrX, jso.app.Constants.Align.Center, jso.Font.Helv, IntFont _
    
56.         , jso.Color.Black, IntStarPage, IntEndPage, True _
    
57.         , True, True, jso.app.Constants.Align.Center, jso.app.Constants.Align.Center _
    
58.         , 0, 0, False, DouZoom _
    
59.         , False, IntAngle, DouTSC)
    
60.    
    
61.     If PathB = "" Then PathB = Path
    
62.     pdDoc.Save 1, PathB  '这里可以是不同于打开的pdf文件名,相当于另存为;如果是和打开的pdf文件名相同,自动保存不提示
    
63.     pdDoc.Close
    
64.     Set pdDoc = Nothing
    
65.     Set pdApp = Nothing
    
66.    
    
67. End Sub
    
68. 
    

复制代码

wudongxian

无法创建部件，在哪里下载Acrobat.AcroApp控件？

opiona

wudongxian 发表于 2020-10-20 15:42
无法创建部件，在哪里下载Acrobat.AcroApp控件？

安装 Adobe Acrobat  建议专业版!

流浪雁江

opiona 发表于 2020-10-20 20:39
安装 Adobe Acrobat  建议专业版!

把jso.Font.Helv改为"宋体"可以实现中文水印

游乐缘

感谢分享，留名学习

blackttea1

感谢分享，学习