はじめに
本記事の目的についてはこの連載の初回記事を見てください。
今回は、Amazonの電子書籍（Kindle）のPDF化（前回記事でキャプチャしたPNGをPDFにする方法）について記載します。
画像の切り抜き位置とサイズ
キャプチャしたPNGから各ページを切り抜くには切り抜き位置（XY座標）とサイズ（幅、高さ）が必要です。
まず、ペイントでキャプチャしたPNGを開き、左上と右下の座標を調べます。
下記画像のように、①拡大→②マウスカーソルの位置合わせ→③左下に表示されている座標確認を行ってください。
左上(X1, Y1)と右下(X2, Y2)が分かれば、幅は(X2 – X1)、高さは(Y2 – Y1) となります。コミックのように左右２ページある場合は、幅を半分にして、右側ページの切り抜き位置は(X1+幅、Y1)となります。
画像切り抜きとPDF化を行うVBSスクリプト
python にするか ruby にするかWSLのbashにするか、いろいろ迷いましたが新たにインストール作業が必要なものは使ってもらえない気がしたので、少し面倒でしたがインストール不要のVBSで作成しました。
共通部（ebook_funcs.vbs)
下記スクリプトを任意のフォルダ（私は C:\tools\ebook にしています）に、ebook_funcs.vbs として保存してください。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。
メモ帳で保存する場合
1.下記ソースの右上をクリック（クリップボードにコピーされます）
2.メモ帳を起動し貼り付け
3.名前を付けて保存で、ファイル名にebook_funcs.vbsを入力、エンコードはANSIを選択し保存
Option Explicit
Dim objFso
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
Dim objShell
Set objShell = CreateObject("WScript.Shell")
' 呼び出し元が cscript(CUI) か wscript(GUI) か判断
Function IsGUI()
Dim wshname
wshname = LCase(Right(WScript.FullName, 11))
If wshname = "cscript.exe" Then
IsGUI = False
Else
IsGUI = True
End If
End Function
' GUI 呼び出しなら CUI で呼びなおす
If IsGUI() Then
WScript.CreateObject("WScript.Shell").Run("cscript //NoLogo """ & WScript.ScriptFullName & """" & " /rerun:1")
WScript.Quit
End If
' 最初からCUIで実行されたか、GUI実行後CUIで実行されたかの判断
Dim gui_cui_re_run
Dim args
Set args = WScript.Arguments
If args.Named.Exists("rerun") = True Then
gui_cui_re_run = True
Else
gui_cui_re_run = False
End If
' スクリプト終了。GUI実行後CUIで実行された場合は、エラーメッセージ等を読めるように少し待ってから終了する
Sub QuitScript(sleep_sec)
If gui_cui_re_run Then WScript.Sleep 1000 * sleep_sec
WScript.Quit
End Sub
' フォルダ作成
Function CreateFolderEx(ByVal folder)
Dim result
Dim parent_dir
parent_dir = objFso.GetParentFolderName(folder)
result = True
If parent_dir <> "" Then
If objFso.FolderExists(parent_dir) = False Then
result = CreateFolderEx(parent_dir)
End If
End If
If result Then
If Not objFso.FolderExists(folder) Then
objFso.CreateFolder(folder)
End If
End If
If objFso.FolderExists(folder) Then
CreateFolderEx = True
Else
CreateFolderEx = False
End If
End Function
' バブルソート（ソートがvbs標準に無いので自作）
Sub swap(ByRef x, ByRef y)
Dim d
d = x
x = y
y = d
End Sub
Sub SortBubble(ByRef a)
Dim i
For i = 0 To UBound(a) - 1
Dim j
For j = i + 1 To UBound(a)
If StrComp(a(j), a(i)) < 0 Then
Call swap(a(i), a(j))
End If
Next
Next
End Sub
' ファイル一覧取得（[topfoldername] にある、拡張子[ext] のファイル一覧を [filelist] に取得）
Function FindFiles(ByVal topfoldername, ByVal ext, ByRef filelist)
Dim num_files
num_files = 0
If Not objFso.FolderExists(topfoldername) Then
FindFiles = num_files
Exit Function
End If
Dim topfolder
Set topfolder = objFso.GetFolder(topfoldername)
Dim subdir
Dim file
Dim select_flg
Dim idx
idx = UBound(filelist)
For Each file In topfolder.Files
select_flg = True
If ext <> "" Then
' 拡張子が引数extと一致するファイルのみ
If UCase(objFso.GetExtensionName(file.Name)) = UCase(ext) Then
select_flg = True
End If
End If
If select_flg Then
ReDim Preserve filelist(idx)
filelist(idx) = file.Name
idx = idx + 1
num_files = num_files + 1
End If
Next
If num_files >= 2 Then
Call SortBubble(filelist)
End If
FindFiles = num_files
End Function
' 指定したフォルダと、そのフォルダ内の全てのファイルを削除
Function DeleteFolderFiles(ByVal folder_name)
On Error Resume Next
If objFso.FolderExists(folder_name) Then
objFso.DeleteFolder folder_name, True
ElseIf objFso.FileExists(folder_name) Then
objFso.DeleteFile folder_name, True
End If
On Error Goto 0
If objFso.FolderExists(folder_name) Or objFso.FileExists(folder_name) Then
DeleteFolderFiles = False
Else
DeleteFolderFiles = True
End If
End Function
' ファイルコピー(コピー先フォルダ作成、既存ファイルは上書き)
Function CopyFileOverWrite(ByVal from_file_name, ByVal to_file_name)
CopyFileOverWrite = False
If objFso.FileExists(from_file_name) = False Then
' 元ファイルがない
Exit Function
End If
On Error Resume Next
' コピー先の親フォルダを作成
If CreateFolderEx(objFso.GetParentFolderName(to_file_name)) Then
Err.Clear
objFso.CopyFile from_file_name, to_file_name, True
If Err.Number = 0 Then
CopyFileOverWrite = True
End If
End If
Err.Clear
On Error Goto 0
End Function
'-------------------------------------------------------------------------------
' ImageMagick コマンド （★↓パス変更要）
Const MAGICK_CMD = "C:\Program Files\ImageMagick-7.1.0-Q16-HDRI\magick.exe"
Dim CONVERT_CMD
CONVERT_CMD = """" + MAGICK_CMD + """ convert"
' キャプチャ画像の出力先フォルダ （★↓パス変更要）
Const CAPTURE_DIR = "C:\tools\WinShot\output"
' CAPTURE_DIR の下に作成する作業用フォルダ
Const EBOOK_PAGES_DIR = "ebook_pages"
Dim img_filelist()
Dim num_img_files
' 初期処理
Sub InitEBook()
If objFso.FolderExists(CAPTURE_DIR) = False Then
WScript.Echo "[" + CAPTURE_DIR + "] フォルダが見つかりません"
Call QuitScript(2)
End If
If objFso.FileExists(MAGICK_CMD) = False Then
WScript.Echo "[" + MAGICK_CMD + "] コマンドが見つかりません"
Call QuitScript(2)
End If
objShell.CurrentDirectory = CAPTURE_DIR
WScript.Echo objShell.CurrentDirectory
ReDim Preserve img_filelist(0)
num_img_files = FindFiles(".", "PNG", img_filelist)
If num_img_files <= 0 Then
WScript.Echo "[" + CAPTURE_DIR + "] PNGファイルがありません"
Call QuitScript(2)
End If
DeleteFolderFiles(EBOOK_PAGES_DIR)
CreateFolderEx(EBOOK_PAGES_DIR)
End Sub
スクリプト中の★については環境によって変更する箇所です。
コミック本のPDF化(png2pdf_kindle_comic.vbs)
下記スクリプトを共通部（ebook_funcs.vbs）と同じフォルダに、png2pdf_kindle_comic.vbs として保存してください。。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。
メモ帳で保存する場合
1.下記ソースの右上をクリック（クリップボードにコピーされます）
2.メモ帳を起動し貼り付け
3.名前を付けて保存で、ファイル名にpng2pdf_kindle_comic.vbsを入力、エンコードはANSIを選択し保存
Option Explicit
' ebook_funcs.vbs を include
Sub Include(ByVal vbsfilename)
Dim objFSO, objStream
On Error Resume Next
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim vbsfilepath
vbsfilepath = objFSO.GetFile(WScript.ScriptFullName).ParentFolder & "\" & vbsfilename
If objFSO.FileExists(vbsfilepath) Then
Err.Clear
Set objStream = objFSO.OpenTextFile(vbsfilepath, 1)
If Err.Number = 0 Then
ExecuteGlobal objStream.ReadAll()
objStream.Close
End If
End If
On Error Goto 0
Set objStream = Nothing
Set objFSO = Nothing
End Sub
Call Include("ebook_funcs.vbs")
'-------------------------------------------------------------------------------
Call InitEBook()
Dim num_page
Dim idx
Dim fname
Dim basename
Dim cmd
Dim first_one_page
Dim last_one_page
Dim ret
' 最初と最後の画像については、中央１ページか左右２ページかを確認
If MsgBox("最初の画像は１ページですか？", vbYesNo, "ページ数確認") = vbYes Then
first_one_page = True
Else
first_one_page = False
End If
If (num_img_files >= 2) Then
' 画像ファイルが複数あれば「最後」のページ数を確認
WScript.Sleep 300
If MsgBox("最後の画像は１ページですか？", vbYesNo, "ページ数確認") = vbYes Then
last_one_page = True
Else
last_one_page = False
End If
Else
last_one_page = False
End If
For idx = 0 To (num_img_files - 1)
fname = img_filelist(idx)
basename = UCase(objFso.GetBaseName(fname))
WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"
' 1画像のページ数(1 or 2) 設定
num_page = 2
If idx = 0 Then
' 最初
If first_one_page Then
num_page = 1
Else
num_page = 2
End If
End If
If (num_img_files >= 2) Then
If idx = (num_img_files - 1) Then
' 最後
If last_one_page Then
num_page = 1
Else
num_page = 2
End If
End If
End If
If num_page = 1 Then
' 中央の１ページを抽出 （★↓座標は変更要）
cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+496+102! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
ret = objShell.Run(cmd, 0, TRUE)
Else
' 左右の２ページを抽出 （★↓座標は変更要）
cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+872+102! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
ret = objShell.Run(cmd, 0, TRUE)
cmd = CONVERT_CMD & " " & fname & " -crop 750x1060+122+102! " + EBOOK_PAGES_DIR + "/" & basename & "-2.PNG"
ret = objShell.Run(cmd, 0, TRUE)
End If
Next
objShell.CurrentDirectory = EBOOK_PAGES_DIR
WScript.Echo "PNG → PDF (しばらくお待ちください)"
' cmd = CONVERT_CMD & " *.PNG output.pdf"
cmd = CONVERT_CMD & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)
Call QuitScript(2)
スクリプト中の★については環境によって変更する箇所です。
ImageMagick convert コマンドの引数については、ImageMagick 画像(PNG)の切り抜き(crop)とPDF化 を参照してください。
文庫本のPDF化(png2pdf_kindle_novel.vbs)
下記スクリプトを共通部（ebook_funcs.vbs）と同じフォルダに、png2pdf_kindle_novel.vbs として保存してください。 ※Shift-JIS(CP932)で保存しないと正常に動作しないようです。
メモ帳で保存する場合
1.下記ソースの右上をクリック（クリップボードにコピーされます）
2.メモ帳を起動し貼り付け
3.名前を付けて保存で、ファイル名にpng2pdf_kindle_novel.vbsを入力、エンコードはANSIを選択し保存
Option Explicit
' ebook_funcs.vbs を include
Sub Include(ByVal vbsfilename)
Dim objFSO, objStream
On Error Resume Next
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim vbsfilepath
vbsfilepath = objFSO.GetFile(WScript.ScriptFullName).ParentFolder & "\" & vbsfilename
If objFSO.FileExists(vbsfilepath) Then
Err.Clear
Set objStream = objFSO.OpenTextFile(vbsfilepath, 1)
If Err.Number = 0 Then
ExecuteGlobal objStream.ReadAll()
objStream.Close
End If
End If
On Error Goto 0
Set objStream = Nothing
Set objFSO = Nothing
End Sub
Call Include("ebook_funcs.vbs")
'-------------------------------------------------------------------------------
Call InitEBook()
Dim idx
Dim fname
Dim cmd
Dim ret
For idx = 0 To (num_img_files - 1)
fname = img_filelist(idx)
WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"
' ページ抽出 （★↓座標は変更要）
cmd = CONVERT_CMD & " " & fname & " -crop 668x897+96+117! " + EBOOK_PAGES_DIR + "/" & fname
ret = objShell.Run(cmd, 0, TRUE)
Next
objShell.CurrentDirectory = EBOOK_PAGES_DIR
WScript.Echo "PNG → PDF (しばらくお待ちください)"
' cmd = CONVERT_CMD & " *.PNG output.pdf"
cmd = CONVERT_CMD & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)
Call QuitScript(2)
スクリプト中の★については環境によって変更する箇所です。
2023/1/20追記。最後のPNG→PDFコマンドにdensity と geometryのオプションを追記しました。SumatraPDF だとオプションなしでも正しく表示できたのですが、その他のViewerだと画面の一部しか表示できないという問題がありました。
ImageMagick convert コマンドの引数については、ImageMagick 画像(PNG)の切り抜き(crop)とPDF化 を参照してください。
スクリプトの実行
コミック本は png2pdf_kindle_comic.vbs、文庫本は png2pdf_kindle_novel.vbs をダブルクリックしてください。
キャプチャ保存フォルダの下の ebook_pages フォルダの下に、output.pdf が作成されます。
次回は楽天Koboのキャプチャを行います。
コメント