メモ
透かしを追加(ファイル)
使い捨てスクリプト
' Excel 2019, Acrobat Standard DC (2022年4月頃), Windows 11 ' 参照設定 ' Acrobat (Adobe Acrobat 10.0 Type Library) Option Explicit #Const DEBUG_ = False Public DIPath As String Public SourcePage As Long ' ActiveDoc の DIPath と SourcePage を取得 Public Sub GetDIPathAndSourcePage() #If DEBUG_ Then Dim avApp As Acrobat.AcroApp Dim avDoc As Acrobat.AcroAVDoc Dim pdDoc As Acrobat.AcroPDDoc #Else Dim avApp As Object Dim avDoc As Object Dim pdDoc As Object #End If Dim jso As Object On Error GoTo ErrorHandler Set avApp = VBA.Interaction.CreateObject(Class:="AcroExch.App") Set avDoc = avApp.GetActiveDoc() Set pdDoc = avDoc.GetPDDoc() Set jso = pdDoc.GetJSObject() Me.DIPath = jso.Path Me.SourcePage = avDoc.GetAVPageView().GetPageNum() VBA.Interaction.MsgBox _ Prompt:= _ "DIPath: " & Me.DIPath & VBA.Constants.vbCrLf & _ "SourcePage: " & Me.SourcePage, _ Title:="GetDIPathAndSourcePage" ErrorHandler: If Not (VBA.Information.Err.Number = 0) Then Me.DIPath = "" Me.SourcePage = -1 End If Set jso = Nothing Set pdDoc = Nothing Set avDoc = Nothing Set avApp = Nothing Debug.Print VBA.Conversion.Error(VBA.Information.Err.Number) End Sub Public Sub JsoAddWatermarkFromFile( _ ByVal jso As Object, _ ByVal cDIPath As String, ByVal nSourcePage As Long, _ ByVal nStart As Long, ByVal nEnd As Long, _ ByVal bOnTop As Boolean, _ ByVal bOnScreen As Boolean, ByVal bOnPrint As Boolean, _ ByVal nHorizAlign As Long, ByVal nVertAlign As Long, _ ByVal nHorizValue As Double, ByVal nVertValue As Double, _ ByVal bPercentage As Boolean, _ ByVal nScale As Double, _ ByVal bFixedPrint As Boolean, _ ByVal nRotation As Long, ByVal nOpacity As Double _ ) jso.addWatermarkFromFile _ cDIPath, _ nSourcePage, nStart, nEnd, _ bOnTop, bOnScreen, bOnPrint, _ nHorizAlign, nVertAlign, _ nHorizValue, nVertValue, _ bPercentage, _ nScale, _ bFixedPrint, _ nRotation, nOpacity End Sub ' ActiveDoc に取得済の DIPath と SourcePage で透かしを入れる Public Sub ExecAddWatermarkFromFile() #If DEBUG_ Then Dim avApp As Acrobat.AcroApp Dim avDoc As Acrobat.AcroAVDoc Dim pdDoc As Acrobat.AcroPDDoc #Else Dim avApp As Object Dim avDoc As Object Dim pdDoc As Object #End If Dim jso As Object Dim pageNum As Long On Error GoTo ErrorHandler Set avApp = VBA.Interaction.CreateObject(Class:="AcroExch.App") Set avDoc = avApp.GetActiveDoc() Set pdDoc = avDoc.GetPDDoc() Set jso = pdDoc.GetJSObject() pageNum = avDoc.GetAVPageView().GetPageNum() If Not (Me.DIPath = "" Or Me.SourcePage < 0) Then JsoAddWatermarkFromFile _ jso:=jso, _ cDIPath:=Me.DIPath, _ nSourcePage:=Me.SourcePage, _ nStart:=pageNum, nEnd:=pageNum, _ bOnTop:=True, bOnScreen:=True, bOnPrint:=True, _ nHorizAlign:=jso.app.Constants.Align.center, _ nVertAlign:=jso.app.Constants.Align.center, _ nHorizValue:=0 * 72 / 25.4, _ nVertValue:=0 * 72 / 25.4, _ bPercentage:=False, _ nScale:=1, _ bFixedPrint:=False, _ nRotation:=0, nOpacity:=1 VBA.Interaction.MsgBox _ Prompt:= _ "this.path: " & jso.Path & VBA.Constants.vbCrLf & _ "this.pageNum: " & pageNum & VBA.Constants.vbCrLf & _ VBA.Constants.vbCrLf & _ "DIPath: " & Me.DIPath & VBA.Constants.vbCrLf & _ "SourcePage: " & Me.SourcePage, _ Title:="ExecAddWatermarkFromFile" End If ErrorHandler: Set jso = Nothing Set pdDoc = Nothing Set avDoc = Nothing Set avApp = Nothing Debug.Print VBA.Conversion.Error(VBA.Information.Err.Number) End Sub