- PDFをタブに表示させた状態でマクロを実行
- 入力チェック、用紙の向き、回転は考慮しない
- 加工後のPDFで細線が発生する場合あり
Option Explicit
#Const DEBUG_ = False
Public Sub 全ページでページボックスを変更()
#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 paperWidth As Double, paperHeight As Double
Dim pageNum As Long, numPages As Long
Dim rBox() As Variant, rBoxNew(0 To 3) As Variant
Dim xll As Double, yll As Double
Dim xur As Double, yur As Double
Dim marginLeft As Double, marginBottom As Double
Dim xllNew As Double, yllNew As Double
Dim xurNew As Double, yurNew As Double
On Error GoTo ErrorHandler
Set avApp = VBA.Interaction.CreateObject(Class:="AcroExch.App")
Set avDoc = avApp.GetActiveDoc()
Set pdDoc = avDoc.GetPDDoc()
Set jso = pdDoc.GetJSObject()
paperWidth = VBA.Conversion.CDbl( _
VBA.Interaction.InputBox( _
Prompt:="変更後における" & VBA.Constants.vbCrLf & _
"用紙の幅[mm]を半角数字で入力", _
Title:="paperWidth", _
Default:="420" _
) _
)
paperHeight = VBA.Conversion.CDbl( _
VBA.Interaction.InputBox( _
Prompt:="変更後における" & VBA.Constants.vbCrLf & _
"用紙の高さ[mm]を半角数字で入力", _
Title:="paperHeight", _
Default:="297" _
) _
)
numPages = pdDoc.GetNumPages()
For pageNum = 0 To numPages - 1 Step 1
rBox = jso.getPageBox("Crop", pageNum)
xll = rBox(0) * 25.4 / 72
yll = rBox(3) * 25.4 / 72
xur = rBox(2) * 25.4 / 72
yur = rBox(1) * 25.4 / 72
marginLeft = (paperWidth - (xur - xll)) / 2
marginBottom = (paperHeight - (yur - yll)) / 2
xllNew = xll - marginLeft
yllNew = yll - marginBottom
xurNew = xllNew + paperWidth
yurNew = yllNew + paperHeight
rBoxNew(0) = xllNew * 72 / 25.4
rBoxNew(3) = yllNew * 72 / 25.4
rBoxNew(2) = xurNew * 72 / 25.4
rBoxNew(1) = yurNew * 72 / 25.4
jso.setPageBoxes "Crop", pageNum, pageNum, rBoxNew
rBoxNew(0) = 0
rBoxNew(3) = 0
rBoxNew(2) = (xurNew - xllNew) * 72 / 25.4
rBoxNew(1) = (yurNew - yllNew) * 72 / 25.4
jso.setPageBoxes "Media", pageNum, pageNum, rBoxNew
jso.setPageBoxes "Art", pageNum, pageNum
jso.setPageBoxes "Trim", pageNum, pageNum
jso.setPageBoxes "Bleed", pageNum, pageNum
Next pageNum
ErrorHandler:
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 全ページを透かしとして入れる()
#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 paperWidth As Double, paperHeight As Double
Dim watermarkScale As Double
Dim pageNum As Long, numPages As Long
Dim rBoxNew(0 To 3) As Variant
Dim xllNew As Double, yllNew As Double
Dim xurNew As Double, yurNew As Double
On Error GoTo ErrorHandler
Set avApp = VBA.Interaction.CreateObject(Class:="AcroExch.App")
Set avDoc = avApp.GetActiveDoc()
Set pdDoc = avDoc.GetPDDoc()
Set jso = pdDoc.GetJSObject()
paperWidth = VBA.Conversion.CDbl( _
VBA.Interaction.InputBox( _
Prompt:="変更後における" & VBA.Constants.vbCrLf & _
"用紙の幅[mm]を半角数字で入力", _
Title:="paperWidth", _
Default:="297" _
) _
)
paperHeight = VBA.Conversion.CDbl( _
VBA.Interaction.InputBox( _
Prompt:="変更後における" & VBA.Constants.vbCrLf & _
"用紙の高さ[mm]を半角数字で入力", _
Title:="paperHeight", _
Default:="210" _
) _
)
watermarkScale = VBA.Conversion.CDbl( _
VBA.Interaction.InputBox( _
Prompt:= _
"watermarkScale = -1 または 0 < watermarkScale", _
Title:="watermarkScale", _
Default:="0.67" _
) _
)
numPages = pdDoc.GetNumPages()
For pageNum = 0 To numPages - 1 Step 1
jso.newPage numPages + pageNum
xllNew = 0
yllNew = 0
xurNew = paperWidth
yurNew = paperHeight
rBoxNew(0) = xllNew * 72 / 25.4
rBoxNew(3) = yllNew * 72 / 25.4
rBoxNew(2) = xurNew * 72 / 25.4
rBoxNew(1) = yurNew * 72 / 25.4
jso.setPageBoxes _
"Crop", numPages + pageNum, numPages + pageNum, rBoxNew
rBoxNew(0) = 0
rBoxNew(3) = 0
rBoxNew(2) = (xurNew - xllNew) * 72 / 25.4
rBoxNew(1) = (yurNew - yllNew) * 72 / 25.4
jso.setPageBoxes _
"Media", numPages + pageNum, numPages + pageNum, rBoxNew
jso.setPageBoxes _
"Art", numPages + pageNum, numPages + pageNum
jso.setPageBoxes _
"Trim", numPages + pageNum, numPages + pageNum
jso.setPageBoxes _
"Bleed", numPages + pageNum, numPages + pageNum
JsoAddWatermarkFromFile _
jso:=jso, _
cDIPath:=jso.Path, _
nSourcePage:=pageNum, _
nStart:=numPages + pageNum, nEnd:=numPages + 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:=watermarkScale, _
bFixedPrint:=False, _
nRotation:=0, nOpacity:=1
Next pageNum
pdDoc.DeletePages nStartPage:=0, nEndPage:=numPages - 1
ErrorHandler:
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
Public Sub JavaScriptデバッガーのウィンドウを表示()
On Error GoTo ErrorHandler
With VBA.Interaction.CreateObject(Class:="AcroExch.App")
.GetActiveDoc().GetPDDoc().GetJSObject().console.Show
End With
ErrorHandler:
Debug.Print VBA.Conversion.Error(VBA.Information.Err.Number)
End Sub
