PDF文件操作系列之一：向PDF文件添加文本水印

lss001

……………………………………………………
运行代码前请安装：
Acrobat-7.0-PRO或以上版本
并在Vbe工具中引用：
Adobe Acrobat 7.0 Type Library
AFormAut 1.0 Type Library
                    

lss001

Sub 添加文本水印() ' 支持中文水印

    Set AcroApp = CreateObject("Acroexch.app")
    Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
    Set AcroPDDoc = CreateObject("AcroExch.PDDoc")
    Set AForm = CreateObject("AFormAut.App")
   
'    '中文水印
'    arr = Evaluate("Mid(""您好，世界！"",ROW(A1:A6),1)")
'    w = ""
'    For i = 1 To UBound(arr)
'        w = w & "\u" & Hex(AscW(arr(i, 1)))
'    Next

'    ’英文水印
    w = "hello world!"
    AcroApp.CloseAllDocs
    If AcroAVDoc.Open(ThisWorkbook.Path & "\num.pdf", "") Then
       Set AcroPDDoc = AcroAVDoc.GetPDDoc
       AForm.Fields.ExecuteThisJavascript _
       "this.addWatermarkFromText(""" & w & """, 0, ""SimSun"", 24, color.red, 0, 0);"
    End If
   
    AcroPDDoc.Save 1, ThisWorkbook.Path & "\newnum.pdf"
   
    Set AForm = Nothing
    Set AcroPDDoc = Nothing
    Set AcroAVDoc = Nothing
    Set AcroApp = Nothing
End Sub

f8b1987

要安装Acrobat是个问题，这个是收费软件，在企业中不能随意使用

zhumin1025

谁能知道你是否安装？

duinenshu

目前为止唯一一个好用的，想问一下老师，怎么调整位置？参数写进去了之后没有反应
"this.addWatermarkFromText(""" & w & """, 0, ""SimSun"", 25,nHorizAlign:= 0,nVertAlign:=0,color.red,0,0);"

lss001

"this.addWatermarkFromText(""" & w & """, 0, ""SimSun"", 25,color.red,0,0,1,1,1,0,0);"
以上后2个参数0,0

向東

反向的删除如何写？

lss001

向東 发表于 2024-9-1 11:15
反向的删除如何写？

这个真没有

duinenshu

lss001 发表于 2024-8-31 12:14
"this.addWatermarkFromText(""" & w & """, 0, ""SimSun"", 25,color.red,0,0,1,1,1,0,0);"
以上后2个参 ...

测试了一下后两个参数，只能在中间左侧和中间这两个位置调整，无法调到右上角，您给看看后两个具体怎么调能实现

lss001

duinenshu 发表于 2024-9-10 14:56
测试了一下后两个参数，只能在中间左侧和中间这两个位置调整，无法调到右上角，您给看看后两个具体怎么调 ...

https://club.excelhome.net/thread-1559488-1-1.html?_dsign=90688073
参考一下链接 2楼有详细参数说明