はじめに
本記事の目的についてはこの連載の初回記事を見てください。
今回は、楽天の電子書籍(楽天Kobo)のPDF化(前回記事でキャプチャしたPNGをPDFにする方法)について記載します。
画像の切り抜き位置とサイズ
キャプチャした画像サイズから切り抜き位置とサイズを計算します。
PDF化を行う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_kobo_comic.vbs)
下記スクリプトを共通部(ebook_funcs.vbs)と同じフォルダに、png2pdf_kobo_comic.vbs として保存してください。。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。
メモ帳で保存する場合
1.下記ソースの右上をクリック(クリップボードにコピーされます)
2.メモ帳を起動し貼り付け
3.名前を付けて保存で、ファイル名にpng2pdf_kobo_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")
'-------------------------------------------------------------------------------
Dim num_page
Dim idx
Dim fname
Dim basename
Dim cmd
Dim first_one_page
Dim last_one_page
Dim ret
Call InitEBook()
' 最初と最後の画像については、中央1ページか左右2ページかを確認
If MsgBox("最初の画像は1ページですか?", 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("最後の画像は1ページですか?", 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
' 中央の1ページを抽出 (★↓座標は変更要)
cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+393+1! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
ret = objShell.Run(cmd, 0, TRUE)
Else
' 左右の2ページを抽出 (★↓座標は変更要)
cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+787+1! " + EBOOK_PAGES_DIR + "/" & basename & "-1.PNG"
ret = objShell.Run(cmd, 0, TRUE)
cmd = CONVERT_CMD & " " & fname & " -crop 787x1082+1+1! " + 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 & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)
Call QuitScript(2)
スクリプト中の★については環境によって変更する箇所です。
文庫本のPDF化png2pdf_kobo_novel.vbs)
下記スクリプトを共通部(ebook_funcs.vbs)と同じフォルダに、png2pdf_kobo_novel.vbs として保存してください。。※Shift-JIS(CP932)で保存しないと正常に動作しないようです。
メモ帳で保存する場合
1.下記ソースの右上をクリック(クリップボードにコピーされます)
2.メモ帳を起動し貼り付け
3.名前を付けて保存で、ファイル名にpng2pdf_kobo_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")
'-------------------------------------------------------------------------------
Dim idx
Dim fname
Dim cmd
Dim ret
Call InitEBook()
For idx = 0 To (num_img_files - 1)
fname = img_filelist(idx)
WScript.Echo fname + " (" + CStr(idx+1) + "/" + CStr(num_img_files) + ")"
ret = CopyFileOverWrite(fname, EBOOK_PAGES_DIR + "/" & fname)
Next
objShell.CurrentDirectory = EBOOK_PAGES_DIR
WScript.Echo "PNG → PDF (しばらくお待ちください)"
cmd = CONVERT_CMD & " -density 75 -geometry 620x877 *.PNG output.pdf"
ret = objShell.Run(cmd, 0, TRUE)
Call QuitScript(2)
スクリプトの実行
コミック本は png2pdf_kobo_comic.vbs、文庫本は png2pdf_kobo_novel.vbs をダブルクリックしてください。
キャプチャ保存フォルダの下の ebook_pages フォルダの下に、output.pdf が作成されます。
コメント