全体フロー
Excel（コメント一覧）
↓ VBAマクロ実行（Alt+F8）
JavaScript コード生成 → クリップボードへ自動コピー
↓ PDF-XChange Editor で Ctrl+J → Ctrl+V → Enter
PDF 各ページにコメント追加完了 → Ctrl+S で保存初回セットアップ（1回だけ）
コメント一覧_テンプレート_v3.xlsxを開く- Alt+F11（VBAエディタを開く）
- 挿入 → 標準モジュール
- VBAコードを貼り付け
- VBAエディタを閉じる
- 名前を付けて保存 → 種類を 「Excel マクロ有効ブック (.xlsm)」 で保存
毎回の操作
Step 1: Excel でデータ入力
「コメント一覧」シートに入力（1行目はヘッダー）
| A列（図番） | B列（コメント） |
|---|---|
| DWG-001 | 承認済み |
| DWG-002 | 要修正：寸法確認 |
※ 2行目 → PDFの1ページ目、3行目 → 2ページ目 … と対応
Step 2: 設定を調整（任意）
「設定」シートでドロップダウンから選択
| 項目 | 初期値 | 選択肢 |
|---|---|---|
| フォントサイズ | 10 | 8～14 推奨 |
| フォント | HelvB | HelvB / Helv / Cour / CourB / Times / TimesB |
| 文字色 | red | red / blue / black / green |
| 背景色 | white | white / yellow / none（透明） |
| 枠線 | なし | あり / なし |
| 枠線色 | black | red / blue / black / green |
| 位置 | 左上 | 左上 / 右上 / 左下 / 右下 |
Step 3: マクロ実行
Alt+F8 → 「JS生成_クリップボードコピー」→ 実行
→ JavaScriptが自動でクリップボードにコピーされる
Step 4: PDF-XChange Editor で貼り付け
- PDFを開く
- Ctrl+J（JSコンソールを開く）
- Ctrl+V（貼り付け）
- Enter（実行）→ 完了ダイアログ
- Ctrl+S（保存）
技術ポイント
VBAマクロの役割
- Excelの「コメント一覧」シートから図番・コメントを読み取り
- 「設定」シートからフォント・色・位置の設定を読み取り
- PDF-XChange Editor の JSコンソールで実行可能な JavaScript を自動生成
- 生成したコードをクリップボードにコピー
生成される JavaScript の処理内容
this.numPagesで PDF の総ページ数を取得- 各ページの寸法を
this.getPageBox("Crop", i)で取得 - テキスト幅を全角/半角で自動計算（全角=fontSize幅、半角=fontSize×0.55）
- 指定位置（左上/右上/左下/右下）に応じた座標を算出
this.addAnnot()で FreeText アノテーションとして追加
必要な環境
- Excel（マクロ有効）
- PDF-XChange Editor（無料版OK）
- 追加インストール：なし
Sub JS生成_クリップボードコピー()
'-------------------------------------------
' PDFコメント貼付ツール v2
' 背景色・枠線・フォント・位置対応版
'-------------------------------------------
Dim wsData As Worksheet
Dim wsSetting As Worksheet
Set wsData = ThisWorkbook.Sheets("コメント一覧")
' === 設定読み込み ===
Dim fontSize As Long
Dim fontName As String
Dim textColor As String
Dim bgColor As String
Dim borderOn As String
Dim borderColor As String
Dim position As String
On Error Resume Next
Set wsSetting = ThisWorkbook.Sheets("設定")
On Error GoTo 0
If Not wsSetting Is Nothing Then
fontSize = wsSetting.Cells(3, 2).Value
fontName = CStr(wsSetting.Cells(4, 2).Value)
textColor = CStr(wsSetting.Cells(5, 2).Value)
bgColor = CStr(wsSetting.Cells(7, 2).Value)
borderOn = CStr(wsSetting.Cells(8, 2).Value)
borderColor = CStr(wsSetting.Cells(9, 2).Value)
position = CStr(wsSetting.Cells(11, 2).Value)
End If
' デフォルト値
If fontSize = 0 Then fontSize = 10
If fontName = "" Then fontName = "HelvB"
If textColor = "" Then textColor = "red"
If bgColor = "" Then bgColor = "white"
If borderOn = "" Then borderOn = "なし"
If borderColor = "" Then borderColor = "black"
If position = "" Then position = "左上"
' 色マッピング関数
Dim jsTextColor As String
jsTextColor = ColorToJS(textColor)
Dim jsBorderColor As String
jsBorderColor = ColorToJS(borderColor)
' 背景色
Dim jsFillColor As String
Select Case LCase(bgColor)
Case "white": jsFillColor = "[""RGB"",1,1,1]"
Case "yellow": jsFillColor = "[""RGB"",1,1,0.8]"
Case "none": jsFillColor = "[""T""]"
Case Else: jsFillColor = "[""RGB"",1,1,1]"
End Select
' 枠線
Dim jsStrokeColor As String
Dim jsBorderWidth As String
If borderOn = "あり" Then
jsStrokeColor = jsBorderColor
jsBorderWidth = "1"
Else
jsStrokeColor = "[""T""]"
jsBorderWidth = "0"
End If
' === データ読み込み ===
Dim row As Long
Dim dataCount As Long
row = 2
dataCount = 0
Do While wsData.Cells(row, 1).Value <> "" Or wsData.Cells(row, 2).Value <> ""
dataCount = dataCount + 1
row = row + 1
Loop
If dataCount = 0 Then
MsgBox "コメントデータがありません。" & vbCrLf & _
"「コメント一覧」シートの2行目以降にデータを入力してください。", vbExclamation
Exit Sub
End If
' === JavaScript生成 ===
Dim js As String
Dim Q As String
Q = Chr(34)
js = "// PDF コメント貼付スクリプト v2" & vbLf
js = js & "// 生成: " & Format(Now, "yyyy/mm/dd hh:nn:ss") & vbLf
js = js & "var comments = [" & vbLf
row = 2
Do While wsData.Cells(row, 1).Value <> "" Or wsData.Cells(row, 2).Value <> ""
Dim figNum As String
Dim comment As String
Dim displayText As String
figNum = CStr(wsData.Cells(row, 1).Value)
comment = CStr(wsData.Cells(row, 2).Value)
displayText = Replace(comment, "\", "\\")
displayText = Replace(displayText, Q, "\" & Q)
If figNum <> "" Then
figNum = Replace(figNum, "\", "\\")
figNum = Replace(figNum, Q, "\" & Q)
displayText = "[" & figNum & "] " & displayText
End If
js = js & " " & Q & displayText & Q & "," & vbLf
row = row + 1
Loop
js = js & "];" & vbLf & vbLf
' テキスト幅計算関数（全角/半角対応）
js = js & "function calcW(s, sz) {" & vbLf
js = js & " var w = 0;" & vbLf
js = js & " for (var j = 0; j " & Chr(60) & " s.length; j++) {" & vbLf
js = js & " w += (s.charCodeAt(j) > 255) ? sz : sz * 0.55;" & vbLf
js = js & " }" & vbLf
js = js & " return w + 2;" & vbLf 'テキスト幅計算(余白)
js = js & "}" & vbLf & vbLf
' メインループ
js = js & "var n = this.numPages;" & vbLf
js = js & "var added = 0;" & vbLf
js = js & "var fs = " & fontSize & ";" & vbLf
js = js & "var margin = 2;" & vbLf '高さ＋マージン（フィット＋端寄せ）
js = js & "for (var i = 0; i " & Chr(60) & " n " & Chr(38) & Chr(38) & " i " & Chr(60) & " comments.length; i++) {" & vbLf
js = js & " if (comments[i] === " & Q & Q & ") continue;" & vbLf
js = js & " var pg = this.getPageBox(" & Q & "Crop" & Q & ", i);" & vbLf
js = js & " var tw = calcW(comments[i], fs);" & vbLf
js = js & " var th = fs + 2;" & vbLf 'アノテーション高さ(余白)
' 位置計算
Dim rectJS As String
Select Case position
Case "左上"
rectJS = " var rc = [margin, pg[1]-margin, margin+tw, pg[1]-margin-th];"
Case "右上"
rectJS = " var rc = [pg[2]-margin-tw, pg[1]-margin, pg[2]-margin, pg[1]-margin-th];"
Case "左下"
rectJS = " var rc = [margin, pg[3]+margin+th, margin+tw, pg[3]+margin];"
Case "右下"
rectJS = " var rc = [pg[2]-margin-tw, pg[3]+margin+th, pg[2]-margin, pg[3]+margin];"
Case Else
rectJS = " var rc = [margin, pg[1]-margin, margin+tw, pg[1]-margin-th];"
End Select
js = js & rectJS & vbLf
' テキスト揃え (0=左, 1=中央, 2=右)
Dim jsAlign As String
If position = "右上" Or position = "右下" Then
jsAlign = "2"
Else
jsAlign = "0"
End If
js = js & " this.addAnnot({" & vbLf
js = js & " type: " & Q & "FreeText" & Q & "," & vbLf
js = js & " page: i," & vbLf
js = js & " rect: rc," & vbLf
js = js & " contents: comments[i]," & vbLf
js = js & " textFont: font." & fontName & "," & vbLf
js = js & " textSize: fs," & vbLf
js = js & " textColor: " & jsTextColor & "," & vbLf
js = js & " fillColor: " & jsFillColor & "," & vbLf
js = js & " strokeColor: " & jsStrokeColor & "," & vbLf
js = js & " borderEffectStyle: " & Q & Q & "," & vbLf
js = js & " width: " & jsBorderWidth & "," & vbLf
js = js & " opacity: 0.95," & vbLf
js = js & " Q: " & jsAlign & vbLf
js = js & " });" & vbLf
js = js & " added++;" & vbLf
js = js & "}" & vbLf
js = js & "app.alert(" & Q & "完了！ " & Q & "+added+" & Q & " ページにコメントを追加しました。\nCtrl+S で保存してください。" & Q & ", 3);" & vbLf
' === クリップボードにコピー ===
Dim objData As Object
Set objData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objData.SetText js
objData.PutInClipboard
Set objData = Nothing
MsgBox dataCount & " 件のコメントからJavaScriptを生成しました！" & vbCrLf & vbCrLf & _
"クリップボードにコピー済みです。" & vbCrLf & vbCrLf & _
"【設定内容】" & vbCrLf & _
" フォント: " & fontName & " / サイズ: " & fontSize & vbCrLf & _
" 位置: " & position & " / 文字色: " & textColor & vbCrLf & _
" 背景: " & bgColor & " / 枠線: " & borderOn & vbCrLf & vbCrLf & _
"【次の手順】" & vbCrLf & _
"1. PDF-XChange Editor でPDFを開く" & vbCrLf & _
"2. Ctrl+J → Ctrl+V → Enter → Ctrl+S", _
vbInformation, "PDF コメント貼付ツール"
End Sub
Private Function ColorToJS(colorName As String) As String
Select Case LCase(colorName)
Case "red": ColorToJS = "color.red"
Case "blue": ColorToJS = "color.blue"
Case "black": ColorToJS = "color.black"
Case "green": ColorToJS = "color.green"
Case Else: ColorToJS = "color.red"
End Select
End Function
コメント