Poppler:PDFに埋め込まれた画像を保存するVBA関数

TOP > Poppler ツール > *


A lack of color

概要

PDF内の画像を抽出してファイル保存します。

Acrobat OLE を使わずに Popplerpdfimages.exe をコマンドライン起動して使用します。

  1. 事前に各種エラーチェック
  2. 「-list」オプションでPDF内の画像数を確認します。
    ゼロ件の時は以降の処理をスキップします。
  3. 保存する画像の各種情報を抽出します。
  4. 画像を pdfimages.exe でファイル保存します。

Poppler とは

フリーソフト Poppler を知らない人は先にコチラを御覧ください。

形式

001 Public Function popSaveImage( _ 002 ByVal popPara_InPdfPath As String, _ 003 ByVal popPara_InPdfPassword As String, _ 004 ByVal popPara_Option As String, _ 005 ByVal popPara_ImageRoot As String, _ 006 ByRef popPara_FileCount As Long, _ 007 ByRef popPara_AllSize As Long, _ 008 ByRef popPara_ImageList() As String, _ 009 ByRef strErr As String) As Boolean


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

引数

  1. 第1引数:popPara_InPdfPath As String  (In)
    入力のPDFファイルのフルパス
  2. 第2引数:popPara_InPdfPassword As String  (In)
    入力のPDFファイルのユーザーパスワード。無ければ""。
  3. 第3引数:popPara_Option As String  (In)
    画像出力時のオプション(任意)
    これに関する詳細はココのOptionsを参照して下さい。
  4. 第4引数:popPara_ImageRoot As String  (In)
    画像のルート名(任意)
    これに関する詳細はココのimage root を参照して下さい。
    但し、当VBA関数は機能を拡張しています。拡張部分に関してはこのページ後半の「画像のルート名:image root」を参照してください。
  5. 第5引数:popPara_FileCount As Long  (Out)
    画像ファイルのファイル数
    この値は正確では無いです。popPara_ImageList(x,y)の x の次元数を参照してください。このページの後半でまた説明します。
  6. 第6引数:popPara_AllSize As Long  (Out)
    PDF内の画像の合計サイズ(Byte)です。出力サイズの合計では無いです。
  7. 第7引数:popPara_ImageList(x,y) As Long  (Out)
    PDF内の画像の各種情報です。「-list」オプションで取得した内容です。このページの後半でまた説明します。
    x 画像ファイル
    y 各種の情報
  8. 第8引数:strErr As String  (Out)
    プログラム内で発生した各種エラーメッセージ。エラー無しは ""。

戻り値

popSaveImage VBA関数の戻り値です。

  • True : 正常終了
    保存する画像がゼロ件でも内部でエラーが無ければ正常終了です。
    strErr = "" の時に正常終了と判断できます。   
  • False : エラー発生
    プログラム内部のエラー、コマンドライン実行時のエラーを含みます。
    strErr <> "" の時にエラーと判断できます。

関数 / サンプル

事前設定

  1. コチラを参考にPoppler のダウンロードとインストールを行います。
  2. pdfimages.exe のフルパスをCON_POPPLER_PATHにセットします。
  3. gDebugMode = True のデバッグモードをFalseにセットします。

サンプル

  • popPara_InPdfPath :
    A-de-001.pdf から添付ファイルの数とファイル一覧を取得します。
  • popPara_InPdfPassword :
    A-de-001.pdf のユーザーパスワードは「def」です。
  • popPara_Option :
    保存する画像は png 形式です。保存ファイル名にはページ番号を追加したいのでオプションを「-png -p」にします。詳細は ココのOptions を参照。
  • popPara_ImageRoot :
    保存フォルダは「I:¥Excel-VBA¥save¥」です。保存する時のファイ名の先頭は入力のPDFのファイル名と同じにします。

DownloadcLine-popSaveImage.xls

001 Option Explicit 002 003 Declare Function WaitForSingleObject Lib "kernel32" _ 004 (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 005 Declare Function CloseHandle Lib "kernel32" _ 006 (ByVal hObject As Long) As Long 007 Declare Function GetExitCodeProcess Lib "kernel32" _ 008 (ByVal hProcess As Long, lpExitCode As Long) As Long 009 Declare Function OpenProcess Lib "kernel32" _ 010 (ByVal dwDesiredAccess As Long, _ 011 ByVal bInheritHandle As Long, _ 012 ByVal dwProcessID As Long) As Long 013 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 014 015 Const SYNCHRONIZE = 1048576 016 Const PROCESS_QUERY_INFORMATION = &H400 017 018 'Poppler-0.45 pdfimages.exe 019 Const CON_POPPLER_PATH = "I:¥Tools¥Run¥Poppler-0.45¥bin¥pdfimages.exe" 020 ' Teme File No 021 Private gFileCnt As Long 022 ' Debug Mode [ True=On | False=Off ] 023 Private gDebugMode As Boolean 024 Private Const CON_FOLDER_KUGIRI = "¥" 025 026 ' テスト用 メイン呼び出しSub 027 028 Sub Main_Demo() 029 gDebugMode = True '実運用ではFalse 030 031 Dim popPara_InPdfPath As String 032 Dim popPara_InPdfPassword As String 033 Dim popPara_Option As String 034 Dim popPara_ImageRoot As String 035 Dim popPara_FileCount As Long 036 Dim popPara_AllSize As Long 037 Dim popPara_ImageList() As String 038 Dim strErr As String 039 Dim bRet As Boolean 040 Dim i As Long 041 Dim j As Long 042 043 If gDebugMode Then Debug.Print "Start:" & Now 044 ' Dim j As Long 045 ' For j = 0 To **** 046 047 '入力PDFのフルパス 048 popPara_InPdfPath = Application.ActiveWorkbook.Path & _ 049 CON_FOLDER_KUGIRI & "a-de-001.pdf" 050 '入力PDFの(文書を開く時の)ユーザーパスワード 051 popPara_InPdfPassword = "def" 052 'オプションの指定 053 popPara_Option = "-png -p" 054 '画像のルート名:Image Root 055 'popPara_ImageRoot = "" 056 'popPara_ImageRoot = "ABC" 057 'popPara_ImageRoot = "save¥ABC" 058 'popPara_ImageRoot = "I:¥Excel-VBA¥save¥ABC" 059 popPara_ImageRoot = "I:¥Excel-VBA¥save¥" 060 061 '関数の呼び出し 062 bRet = popSaveImage( _ 063 popPara_InPdfPath, popPara_InPdfPassword, _ 064 popPara_Option, popPara_ImageRoot, _ 065 popPara_FileCount, popPara_AllSize, _ 066 popPara_ImageList(), strErr) 067 068 '関数の結果を確認 069 If bRet = True Then 070 '正常終了 071 MsgBox "処理は正常に完了しました。" & vbCrLf & _ 072 "保存件数=" & popPara_FileCount & vbCrLf & _ 073 "保存サイズ合計=" & popPara_AllSize & " byte", _ 074 vbInformation, "正常終了" 075 Else 076 'エラー 077 MsgBox strErr, vbCritical, "実行エラー" 078 Exit Sub 079 End If 080 081 '画像ファイルが保存できた。正常終了 082 Dim sWkMsg As String 083 If gDebugMode = True And popPara_FileCount <> 0 Then 084 For i = 0 To UBound(popPara_ImageList, 1) 085 For j = 0 To UBound(popPara_ImageList, 2) 086 If j = 0 Then 087 sWkMsg = popPara_ImageList(i, j) 088 Else 089 sWkMsg = sWkMsg & " , " & _ 090 popPara_ImageList(i, j) 091 End If 092 Next j 093 Debug.Print sWkMsg 094 Next i 095 End If 096 097 '※正常ならばローカルに保存したファイルを別フォルダに移動する。 098 'name 099 'FileCopy 100 'FileSystemObject 等を使う 101 102 ' Next j 103 If gDebugMode Then Debug.Print "End :" & Now 104 End Sub 105 106 '************************************************** 107 ' 108 ' Save images list from a PDF file as 109 ' PPM,PBM,PNG,TIFF,JPEG,JPEG2000,JBIG2 files. 110 ' 111 ' 機能 : Poppler pdfimages.exeを使ってPDFに埋め込まれている 112 ' 画像ファイルを保存します。 113 ' Create : 2016/07/04 114 ' Update : 2016/07/04 115 ' Vertion : 1.0.0 116 ' 117 ' 第1引数:popPara_InPdfPath As String (In) 118 ' 入力のPDFファイルのフルパス 119 ' 第2引数:popPara_InPdfPassword As String (In) 120 ' 入力のPDFファイルのユーザーパスワード。無ければ""。 121 ' 第3引数:popPara_Option As String (In) 122 ' 画像出力時のオプション(任意) 123 ' 第4引数:popPara_ImageRoot As String (In) 124 ' 画像のルート名(必須) 125 ' 第5引数:popPara_FileCount As Long (Out) 126 ' 画像ファイルのファイル数 127 ' 第6引数:popPara_AllSize As Long (Out) 128 ' 画像ファイルの合計サイズ(Byte) 129 ' 第7引数:popPara_ImageList(x,y) As Long (Out) 130 ' 画像ファイルの情報 131 ' x 画像ファイル 132 ' y 各種の情報 133 ' 第8引数:strErr As String (Out) 134 ' プログラム内のエラーメッセージ。エラー無しは ""。 135 ' 戻り値 : True 正常終了 136 ' False エラー 137 ' 138 ' 備考 : strErr<>""の時はエラー扱いとする。 139 ' URL : https://pdf-file.nnn2.com/?p=878 140 ' その他 : 著作権等は主張しません。 141 ' 上記URLにコメントを頂けると嬉しいです。 142 ' 143 '************************************************** 144 145 Public Function popSaveImage( _ 146 ByVal popPara_InPdfPath As String, _ 147 ByVal popPara_InPdfPassword As String, _ 148 ByVal popPara_Option As String, _ 149 ByVal popPara_ImageRoot As String, _ 150 ByRef popPara_FileCount As Long, _ 151 ByRef popPara_AllSize As Long, _ 152 ByRef popPara_ImageList() As String, _ 153 ByRef strErr As String) As Boolean 154 155 On Error GoTo Err_popSaveImage: 156 Dim strCmdMsg(1) As String 157 Dim strTempFilePath(1) As String 158 Dim strFilePath As String 159 Dim strCmd As String 160 Dim objFileSystem As Object 161 Dim i As Long 162 Dim j As Long 163 Dim bRet As Boolean 164 Dim strDir As String 165 Dim strFileName() As String 166 Dim lFileCount As Long 167 Dim strImageRoot As String 168 Dim strPdfFileName As String 169 Dim strWk1 170 Dim strWk2 171 172 Const CON_OPTION_LIST = "-list" 173 Const CON_MAX_COL = 15 174 175 '初期化 176 Set objFileSystem = CreateObject("Scripting.FileSystemObject") 177 strErr = "" 178 popPara_FileCount = 0 179 popPara_AllSize = 0 180 popSaveImage = False 181 For i = 0 To UBound(strCmdMsg) 182 strCmdMsg(i) = "" 183 strTempFilePath(i) = "" 184 Next i 185 186 'エラーチェック 187 If objFileSystem.FileExists(popPara_InPdfPath) = False Then 188 strErr = popPara_InPdfPath & vbCrLf & _ 189 "[E01]このファイルは存在しません。" 190 Exit Function 191 End If 192 If objFileSystem.FileExists(CON_POPPLER_PATH) = False Then 193 strErr = CON_POPPLER_PATH & vbCrLf & _ 194 "[E02]このファイルは存在しません" 195 Exit Function 196 End If 197 198 popPara_ImageRoot = Trim$(popPara_ImageRoot) 199 If popPara_ImageRoot = "" Then 200 '画像のルート名が無指定の時 201 popPara_ImageRoot = Application.ActiveWorkbook.Path & _ 202 CON_FOLDER_KUGIRI 203 strPdfFileName = Mid$(popPara_InPdfPath, _ 204 InStrRev(popPara_InPdfPath, CON_FOLDER_KUGIRI) + 1) 205 popPara_ImageRoot = popPara_ImageRoot & _ 206 Left$(strPdfFileName, Len(strPdfFileName) - 4) 207 ElseIf Right$(popPara_ImageRoot, 1) = CON_FOLDER_KUGIRI Then 208 '画像のルート名が無指定の時 209 strPdfFileName = Mid$(popPara_InPdfPath, _ 210 InStrRev(popPara_InPdfPath, CON_FOLDER_KUGIRI) + 1) 211 popPara_ImageRoot = popPara_ImageRoot & _ 212 Left$(strPdfFileName, Len(strPdfFileName) - 4) 213 End If 214 215 If InStr(popPara_ImageRoot, CON_FOLDER_KUGIRI) > 0 Then 216 '「画像のルート名」にフォルダ指定が有る 217 If Mid$(popPara_ImageRoot, 2, 2) = (":" & CON_FOLDER_KUGIRI) Then 218 'フルパス指定 219 strFilePath = Left$(popPara_ImageRoot, _ 220 InStrRev(popPara_ImageRoot, CON_FOLDER_KUGIRI)) 221 If Dir(strFilePath, vbDirectory) = "" Then 222 strErr = strFilePath & vbCrLf & _ 223 "[E04]画像の保存先フォルダが存在しません" 224 Exit Function 225 End If 226 Else 227 '相対パス指定 228 strFilePath = Application.ActiveWorkbook.Path & _ 229 CON_FOLDER_KUGIRI & popPara_ImageRoot 230 strFilePath = Left$(strFilePath, InStrRev(strFilePath, CON_FOLDER_KUGIRI)) 231 If Dir(strFilePath, vbDirectory) = "" Then 232 strErr = strFilePath & vbCrLf & _ 233 "[E05]画像の保存先フォルダが存在しません" 234 Exit Function 235 End If 236 End If 237 strDir = strFilePath 238 Else 239 strDir = Application.ActiveWorkbook.Path 240 End If 241 242 bRet = GetDirFile(strDir, strFileName(), lFileCount, strErr) 243 If bRet = False Then Exit Function 244 If lFileCount > 0 Then 245 strImageRoot = Mid$(popPara_ImageRoot, _ 246 InStrRev(popPara_ImageRoot, CON_FOLDER_KUGIRI) + 1) 247 If MsgBox(strDir & vbCrLf & vbCrLf & _ 248 "保存先フォルダに同じ画像のルート名 [" & strImageRoot & _ 249 "] ファイルが " & lFileCount & " 件存在します。" & _ 250 vbCrLf & "上書きされる可能性が有ります" & vbCrLf & vbCrLf & _ 251 "処理を続行しますか?", vbOKCancel + vbQuestion + vbDefaultButton2, "確認") = vbCancel Then 252 strErr = "[E06]処理は中断されました" 253 Exit Function 254 End If 255 End If 256 257 '▼コマンドラインの編集(-list) 258 strCmd = CON_POPPLER_PATH & " " & CON_OPTION_LIST 259 If popPara_InPdfPassword <> "" Then 260 'ユーザーパスワードをセット 261 strCmd = strCmd & " -upw " & popPara_InPdfPassword & " " 262 End If 263 264 '一時ファイル 265 gFileCnt = gFileCnt + 1 266 strFilePath = _ 267 Application.ActiveWorkbook.Path & CON_FOLDER_KUGIRI & _ 268 Format(Now(), "yyyymmdd-hhmmss-") & gFileCnt 269 '標準出力用 270 strTempFilePath(0) = strFilePath & ".txt" 271 '標準エラー出力用 272 strTempFilePath(1) = strFilePath & "-err.txt" 273 274 '注意:ファイルパスの前後にダブルクォーテーション 275 strCmd = strCmd & " " & _ 276 """" & popPara_InPdfPath & _ 277 """ > """ & strTempFilePath(0) & _ 278 """ 2> """ & strTempFilePath(1) & """" 279 280 'コマンドラインの実行 281 strCmd = "cmd /c " & strCmd 282 bRet = RunCommandLine(strCmd, strErr) 283 If gDebugMode Then Debug.Print strCmd 284 285 On Error GoTo popSaveImage_Skip: 286 287 '標準出力のテキストを読み込む 288 bRet = InputTempFile(strTempFilePath(), strCmdMsg(), strErr) 289 If bRet = False Then Exit Function 'エラー発生 290 291 If strCmdMsg(1) <> "" Or strErr <> "" Then 292 'エラー有り 293 strErr = strErr & vbCrLf & vbCrLf & _ 294 "[E11] -list の実行時にエラーが発生しました" & vbCrLf & _ 295 vbCrLf & strTempFilePath(1) & vbCrLf & _ 296 "上記のファイルにエラーが出てるかもしれません" & vbCrLf & _ 297 vbCrLf & strCmdMsg(1) 298 GoTo popSaveImage_Skip: 299 End If 300 301 '▼画像ファイルの一覧を取得 302 strWk1 = Split(strCmdMsg(0), vbCrLf) 303 If UBound(strWk1) <= 1 Then 304 '画像ファイルはゼロ件です★ 305 popPara_FileCount = 0 306 popSaveImage = True '正常終了 307 GoTo popSaveImage_Skip: 308 End If 309 310 '画像ファイルの[-list]情報を抽出 311 popPara_FileCount = UBound(strWk1) - 1 312 ReDim popPara_ImageList(popPara_FileCount - 1, _ 313 CON_MAX_COL) As String 314 Dim lWkSize As Long 315 For i = 2 To popPara_FileCount + 1 316 For j = 0 To 4 317 strWk1(i) = Replace(strWk1(i), " ", " ") 318 Next j 319 strWk2 = Split(strWk1(i), " ") 320 For j = 0 To CON_MAX_COL 321 popPara_ImageList(i - 2, j) = strWk2(j) 322 If j = 14 Then 323 bRet = CovertSizeString(strWk2(j), lWkSize, strErr) 324 If bRet = False Then Exit Function 325 popPara_AllSize = popPara_AllSize + lWkSize 326 End If 327 Next j 328 Next i 329 330 '▼画像保存のコマンドラインの編集 331 strCmd = CON_POPPLER_PATH & " " & popPara_Option 332 If popPara_InPdfPassword <> "" Then 333 'ユーザーパスワードをセット 334 strCmd = strCmd & " -upw " & popPara_InPdfPassword & " " 335 End If 336 337 '注意:ファイルパスの前後にダブルクォーテーション 338 strCmd = strCmd & " " & _ 339 """" & popPara_InPdfPath & _ 340 """ """ & popPara_ImageRoot & """ " & _ 341 " > """ & strTempFilePath(0) & _ 342 """ 2> """ & strTempFilePath(1) & """" 343 344 'コマンドラインの実行 345 strCmd = "cmd /c " & strCmd 346 bRet = RunCommandLine(strCmd, strErr) 347 If gDebugMode Then Debug.Print strCmd 348 349 '標準出力のテキストを読み込む 350 bRet = InputTempFile(strTempFilePath(), strCmdMsg(), strErr) 351 If bRet = False Then Exit Function 'エラー発生 352 353 If strCmdMsg(1) <> "" Or strErr <> "" Then 354 'エラー有り 355 strErr = strErr & vbCrLf & vbCrLf & _ 356 "[E12] 画像の保存の実行時にエラーが発生しました" & vbCrLf & _ 357 strTempFilePath(1) & vbCrLf & _ 358 "上記のファイルにエラーが出てるかもしれません" & vbCrLf & _ 359 vbCrLf & "オプションの内容が間違っている可能性が有ります" 360 GoTo popSaveImage_Skip: 361 End If 362 363 bRet = GetDirFile(strDir, strFileName(), lFileCount, strErr) 364 If gDebugMode Then 365 Debug.Print "lFileCount=" & lFileCount 366 For i = 0 To UBound(strFileName) 367 Debug.Print "strFileName(" & i & ")=" & strFileName(i) 368 Next i 369 End If 370 371 If bRet = False Then Exit Function 'エラー発生 372 373 popSaveImage = True '正常終了 374 popSaveImage_Skip: 375 Set objFileSystem = Nothing 376 Exit Function 377 378 Err_popSaveImage: 379 strErr = "(popSaveImage) Runtime Error :" & _ 380 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 381 vbCrLf & "PDF File=" & popPara_InPdfPath 382 End Function 383 384 ' コマンドラインの標準出力と標準エラー出力の 385 ' テキストファイルを読み込む。 386 387 Function InputTempFile( _ 388 ByRef strTempFilePath() As String, _ 389 ByRef strCmdMsg() As String, _ 390 ByRef strErr As String) As Boolean 391 392 On Error GoTo Err_InputTempFile: 393 Dim strInput As String 394 Dim lFileNo As Long 395 Dim i As Long 396 397 For i = 0 To UBound(strTempFilePath) 398 strCmdMsg(i) = "" 399 lFileNo = FreeFile 400 Open strTempFilePath(i) For Input As #lFileNo 401 Do Until EOF(lFileNo) 402 Line Input #lFileNo, strInput 403 If strCmdMsg(i) = "" Then 404 strCmdMsg(i) = Trim(strInput) 405 Else 406 strCmdMsg(i) = strCmdMsg(i) & _ 407 vbCrLf & Trim(strInput) 408 End If 409 Loop 410 Close #lFileNo 411 Next i 412 413 '一時ファイルの削除 414 If strErr = "" Then 415 For i = 0 To UBound(strTempFilePath) 416 Kill strTempFilePath(i) 417 Next i 418 End If 419 InputTempFile = True 420 Exit Function 421 422 Err_InputTempFile: 423 strErr = "(InputTempFile) Runtime Error :" & _ 424 Err.Number & vbCrLf & Err.Description 425 InputTempFile = False 426 End Function 427 428 ' shell 関数の終了を待つ 429 430 Function RunCommandLine( _ 431 ByVal strCmd As String, _ 432 ByRef strErr As String) As Boolean 433 On Error GoTo Err_RunCommandLine: 434 435 Dim hProcess As Long 436 Dim lpdwExitCode As Long 437 Dim dwProcessID As Long 438 Dim lRet As Long 439 Dim lCnt As Long 440 Const CON_SLEEP = 20 441 Const CON_LOOP_CNT = 250 442 lCnt = 0 443 dwProcessID = Shell(strCmd, vbHide) 444 hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, _ 445 True, dwProcessID) 446 Do 447 Sleep CON_SLEEP 448 DoEvents 449 lRet = GetExitCodeProcess(hProcess, lpdwExitCode) 450 lCnt = lCnt + 1 451 If lCnt > CON_LOOP_CNT Then 452 If gDebugMode Then Debug.Print vbCrLf & strCmd 453 strErr = "[RunCommandLine]Shell Error : Time Orver " & _ 454 CON_SLEEP * CON_LOOP_CNT & "ms" 455 Exit Function 456 End If 457 Loop While lpdwExitCode <> 0 458 RunCommandLine = True 459 Exit Function 460 461 Err_RunCommandLine: 462 strErr = "(RunCommandLine) Runtime Error :" & _ 463 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 464 vbCrLf & "Command=" & strCmd 465 RunCommandLine = False 466 End Function 467 468 ' ディレクトリのファイル一覧を取得する 469 470 Function GetDirFile( _ 471 ByVal strDir As String, _ 472 ByRef strFileName() As String, _ 473 ByRef lFileCount As Long, _ 474 ByRef strErr As String) As Boolean 475 476 On Error GoTo Err_GetDirFile: 477 Dim strBuf As String 478 lFileCount = 0 479 strDir = strDir & "*.*" 480 ReDim strFileName(1) As String 481 strBuf = Dir(strDir) 482 Do While strBuf <> "" 483 lFileCount = lFileCount + 1 484 If UBound(strFileName) <= lFileCount Then 485 ReDim Preserve strFileName(lFileCount - 1) As String 486 End If 487 strFileName(lFileCount - 1) = strBuf 488 strBuf = Dir() 489 Loop 490 GetDirFile = True 491 Exit Function 492 493 Err_GetDirFile: 494 strErr = "(GetDirFile) Runtime Error :" & _ 495 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 496 vbCrLf & "Dir=" & strDir 497 GetDirFile = False 498 End Function 499 500 ' サイズを編集 501 ' 36.8K=36800b 1.52M=1520000b 502 503 Function CovertSizeString( _ 504 ByVal strSize As String, _ 505 ByRef lSize As Long, _ 506 ByRef strErr As String) As Boolean 507 508 On Error GoTo Err_CovertSizeString: 509 Dim strEditSize As String 510 511 Select Case Right$(strSize, 1) 512 Case "B" 513 lSize = Left$(strSize, Len(strSize) - 1) 514 Case "K" 515 strEditSize = Left$(strSize, Len(strSize) - 1) 516 lSize = strEditSize * 1000 517 Case "M" 518 strEditSize = Left$(strSize, Len(strSize) - 1) 519 lSize = strEditSize * 1000 * 1000 520 Case "G" 521 strEditSize = Left$(strSize, Len(strSize) - 1) 522 lSize = strEditSize * 1000 * 1000 * 1000 523 Case Else 524 strErr = "[E50]文字のサイズがバイトに変換できない。" & vbCrLf & _ 525 "strSize=(" & strSize & ")" 526 CovertSizeString = False 527 Exit Function 528 End Select 529 530 CovertSizeString = True 531 Exit Function 532 Err_CovertSizeString: 533 strErr = "(CovertSizeString) Runtime Error :" & _ 534 Err.Number & vbCrLf & Err.Description & vbCrLf & _ 535 vbCrLf & "strSize=" & strSize 536 CovertSizeString = False 537 End Function


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

結果

001 Start:2016/07/04 16:01:08 002 cmd /c I:¥Tools¥Run¥Poppler-0.45¥bin¥pdfimages.exe -list "I:¥Excel-VBA¥A-de-001.pdf" > "I:¥Excel-VBA¥20160704-160108-7.txt" 2> "I:¥Excel-VBA¥20160704-160108-7-err.txt" 003 cmd /c I:¥Tools¥Run¥Poppler-0.45¥bin¥pdfimages.exe -png "I:¥Excel-VBA¥A-de-001.pdf" "I:¥Excel-VBA¥save¥A-de-001" > "I:¥Excel-VBA¥20160704-160108-7.txt" 2> "I:¥Excel-VBA¥20160704-160108-7-err.txt" 004 lFileCount=5 005 strFileName(0)=A-de-001-000.png 006 strFileName(1)=A-de-001-001.png 007 strFileName(2)=A-de-001-002.png 008 strFileName(3)=A-de-001-003.png 009 strFileName(4)=A-de-001-004.png 010 1 , 0 , image , 2000 , 1888 , gray , 1 , 1 , ccitt , no , 132 , 0 , 300 , 300 , 36.8K , 8.0% 011 2 , 1 , image , 1912 , 2004 , gray , 1 , 1 , ccitt , no , 3 , 0 , 300 , 300 , 33.2K , 7.1% 012 3 , 2 , image , 1104 , 991 , rgb , 3 , 8 , jpeg , no , 8 , 0 , 72 , 72 , 46.0K , 1.4% 013 4 , 3 , image , 1006 , 500 , rgb , 3 , 8 , jpeg , no , 12 , 0 , 96 , 96 , 44.3K , 3.0% 014 5 , 4 , image , 640 , 640 , rgb , 3 , 8 , image , no , 17 , 0 , 72 , 72 , 4088B , 0.3% 015 End :2016/07/04 16:01:16


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

  ▽正常終了の時

Poppler:PDFに埋め込まれた画像の保存するVBA関数

▽途中で続行の判断が必要な時。

Poppler:PDFに埋め込まれた画像の保存するVBA関数

▽実行中にエラーが発生して終了した時。

Poppler:PDFに埋め込まれた画像の保存するVBA関数

一番下が pdfimages.exe からのエラーメッセージです。
「Command Line Error : Incorrect password」=「パスワードが間違ってます」 それ以外はプログラム内で編集したエラーメッセージです。

▽オプション「popPara_Option」の設定が間違っている時。

Poppler:PDFに埋め込まれた画像の保存するVBA関数

この場合は pdfimages.exe からの詳細なエラーメッセージは表示されません。代わりに「-help」のオプションを設定したのと状態になります。  

「画像のルート名」  image root について

画像を保存する時にファイル名の先頭の文字列を指定できます。詳細はpdfimages.exe のOptions に説明が有ります。このVBA関数ではその部分を少し拡張して使いやすくしました。

Pdfimages はPDFファイルを読み込み、1つまたは複数のページをスキャンします。そして画像ごとに一つのファイルを書き出します。画像ファイル名は [image-root] - [nnn].[xxx] の形式です。「image-root」はオプションで指定できる画像のルート名、nnnは自動的に振られる画像番号、xxxは画像の種類(.ppm、.pbm、.PNG、.TIF、.JPG、JP2、jb2e、またはjb2g)です。

例で説明します。 例:popPara_ImageRoot = "" の時 [image-root]の部分は入力PDFファイルのファイル名を使います。そして画像の保存先フォルダはExcelファイルの実行フォルダです。PDFファイル名が「OUT_1.pdf」の時は popPara_ImageRoot = "OUT_1"の扱いになります 。

  • OUT_1-000.png
  • OUT_1-001.png
  • OUT_1-002.png

例:popPara_ImageRoot = "ABC" の時 [image-root]の部分は「ABC」が入ります。そして画像の保存先フォルダはExcelファイルの実行フォルダです。PDFファイル名が「OUT_1.pdf」の時は。

  • ABC-000.png
  • ABC-001.png
  • ABC-002.png

例:popPara_ImageRoot = "save¥ABC" [image-root]の部分は「ABC」が入ります。そして画像の保存先フォルダはExcelファイルの実行フォルダの下の「save」フォルダです。このフォルダが存在しないとエラーになります。 例:popPara_ImageRoot = "I:¥Excel-VBA¥save¥ABC" [image-root]の部分は「ABC」が入ります。そして画像の保存先フォルダは「I:¥Excel-VBA¥save¥」フォルダです。このフォルダが存在しないとエラーになります。 例:popPara_ImageRoot = "I:¥Excel-VBA¥save¥" [image-root]の部分は入力PDFファイルのファイル名を使います。そして画像の保存先フォルダは「I:¥Excel-VBA¥save¥」フォルダです。このフォルダが存在しないとエラーになります。  

保存した画像のファイル数

VBA関数の引数 popPara_FileCount にセットされる件数は保存先フォルダに存在する画像のファイル数です。カウント方法は同じ「画像のルート名」を持ったファイル名が存在した場合にしています。よって保存前に他のPDFの処理で同じような名前のファイルが存在するとカウントしてしまいます。 当VBA関数が内部で使用している pdfimages.exe コマンドラインのプログラムはどのファイル名で出力したかの情報は出だしてくれません。よって同じファイル名をもったもので探すしか手がないです。 どうしても正確な件数は知りたい時は引数 popPara_ImageList(x,y) の x の次元数「 Ubound(popPara_ImageList,1) 」で出してください。  

画像の各種ファイル情報

当VBA関数を実行すると引数 popPara_ImageList(x,y) に以下のコマンドを実行したと同じような内容がセットされます。

001 I:¥Tools¥Run¥Poppler-0.45¥bin>pdfimages -list a002.pdf 002 page num type width height color comp bpc enc interp object ID x-ppi y-ppi size ratio 003 -------------------------------------------------------------------------------------------- 004 1 0 image 2000 1888 gray 1 1 ccitt no 135 0 300 300 36.8K 8.0% 005 2 1 image 1912 2004 gray 1 1 ccitt no 3 0 300 300 33.2K 7.1% 006 3 2 image 1104 991 rgb 3 8 jpeg no 8 0 72 72 46.0K 1.4% 007 4 3 image 1006 500 rgb 3 8 jpeg no 12 0 96 96 44.3K 3.0% 008 5 4 image 640 640 rgb 3 8 image no 17 0 72 72 4088B 0.3%


 Highlight:プログラミング言語のソースコードを構文で色分け (GUI編)
 

上記のハイフン「----」以下の内容を引数 popPara_ImageList(x,y) にセットしています。x は縦方向。y は横方向です。

備考

  • 使う人が無いかもしれないと思った割には、作成日数を掛けてしまいました。

< Poppler へ戻る >

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

CAPTCHA



SAMURAI Plugin

コメントをする時は出来れば以下もお願いします。

  • OS名 バージョン
  • Acrobat バージョン
  • ツール(Excel等) バージョン
コメントにサンプルコードを入れる時はコードを全て全角文字列にしてください。コチラで半角に戻します。それでもエラーが回避できない時はコメント下さい。個別に対処します。



お仕事で当サイトを見ている方へ
考え込んだら、ご質問下さい。
一緒に解決策を考えましょう。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください