xlogI125’s blog

パソコン作業を効率化したい

Acrobat IAC練習 addWatermarkFromFile

メモ

透かしを追加(ファイル)

使い捨てスクリプト

' 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