[[20140225111033]]　『PDFファイルのページを指定してシート貼付け』（田吾作）　ページの最後に飛ぶ

『PDFファイルのページを指定してシート貼付け』（田吾作）

 おはようございます。お世話になります。
 下記のコードはPDFファイルをオブジェクトとしてシートに貼り付けるもの
 です。本当は特定のページだけを貼り付けたいのですが方法がわからず以前
 ネットで調べた物を使わせていただいております。

 Sub test()
  Dim fpath As String
  Dim ws As Worksheet
  Dim myobj As Object
   fpath = "D:\test\test2\aaa.pdf"
   If Dir(fpath) <> "" Then
      Set ws = ThisWorkbook.Worksheets(1)
      Set myobj = ws.OLEObjects.Add(Filename:=fpath, Link:=False, DisplayAsIcon:=False)
      Set myobj = Nothing
      Set ws = Nothing
   End If
 End Sub

 今回やりたいことは、PDFファイルの特定のページを指定してシートに貼り
 つける、という作業です。

 現在、手作業でPDFファイルの2ページ目を開き、その内容を目視で確認して
 PDFファイルの名前をリネームしております。
 各PDFファイルは2ページのものです。
 この作業はエクセルは使用して
 いません。

 PDFファイルが50ほど入ったフォルダが10ほどあります。

 1つのフォルダ内の全PDFファイルの2ページ目をシートのセルに一覧表示して、
 そのセルの隣のセルにリネーム後の名前を入力してマクロで自動的にリネーム
 しようと考えています。
 リネームのマクロは出来ています。
 今回お聞きしたいのは、PDFファイルの特定のページをシートの表示できるか、
 という点です。

 ご存知の方、ご教示お願いいたします。

＜使用 Excel：Excel2002、使用 OS：WindowsXP ＞

ReaderのOLE貼付では、先頭ページにしかならないと思います。

元ファイルをバラして欲しいページだけ別PDF（または画像）にしてから貼るとか、
OLE貼付をやめてAcrobat Readerで表示し、Sendkeysでページ変更操作するとか。
（別アプリで表示では、一覧表示目的と違ってしまいますね）

または、製品版Acrobatならば、何とかできるかも。
（???） 2014/02/25(火) 13:30

 Acrobat(有償S/W)があるとできる幅は広がりますが、Reader ではできることも
 制限されます。
http://pdf-file.nnn2.com/

 ですが、このようなコマンドツールもあるようです。
http://nwpct1.hatenablog.com/entry/2013/12/14/192914

 このあたりを組み合わせて使用してはどうでしょうか。
 コマンドは VBA のShell 等から起動できます。
（Mook） 2014/02/25(火) 14:00

 ???さん、Mookさん、ご回答ありがとうございます。

 Mookさんにリンクしていただきましたツールを使用してPDFファイルの特定のページ
 を新規PDFファイルとして切り出すことが出来ました。
 これで切り出したものをシートに貼り付けることにいたします。
 ありがとうございました。

 ↓はpdftkのコマンドをVBAから実行するコードです。
 指定のフォルダ内の全PDFファイルの指定のページを新規フォルダ内に新規PDFファイル
 として保存します。

 Sub test()
  Dim fol As String
  Dim myfile As String
  Dim fpath As String
  Dim newfol As String
  Dim newmyfile As String
  Dim newfpath As String
  Dim kaku As String
  Dim mynum As Integer
  Dim mycmd As String
   'フォルダパス
   fol = "G:\test\mypdf"
   '新規フォルダパス
   newfol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Now, "yymmdd_hhmmss")
   '新規フォルダ作成
   MkDir (newfol)
 　'切り出すページ番号
   mynum = 2
   '対象拡張子
   kaku = "pdf"  
   myfile = Dir(fol & "\*." & kaku)
   'フォルダ内ループ
   Do While myfile <> ""
    'ファイルパス
    fpath = fol & "\" & myfile
    '新規ファイル名
    newmyfile = Left(myfile, InStrRev(myfile, ".") - 1) & "_" & mynum & "." & kaku
    '新規ファイルパス
    newfpath = newfol & "\" & newmyfile
    'コマンド内容
    mycmd = "pdftk " & """" & fpath & """" & " cat " & mynum & " output " & """" & newfpath & """"
    'コマンド実行
    Call Shell(Environ$("ComSpec") & " /c" & mycmd)
    myfile = Dir()
   Loop
   '新規フォルダの起動
   CreateObject("Shell.Application").ShellExecute newfol
 End Sub
（田吾作） 2014/02/26(水) 09:34

 解決済みですが、検索などでこのスレッドをご覧になる方への参考として書いておきます。

 私のPCの環境は

 Windows:XP-SP3
 IE:Version8/セキュリティの状態は？？
 ネット接続：ダイヤルアップ

 ですが、pdftkの「Windows Download」をクリックしてダウンロードしようとしても
 ダウンロードが始まりませんでした。他のサイトでは特にダウンロードが出来なかった
 というような症状は出たことがありませんでした。

 そこで、ソースを表示してダウンロードファイルのURLを取得し(↓です)、

 ttp://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/pdftk_server-2.02-win-setup.exe

 API関数のURLDownloadToFileでPC上にダウンロードしました。↓はURLDownloadToFileの解説
 ページです。

 Office TANAKA - 番外編[画像をダウンロードする]
http://officetanaka.net/other/extra/tips01.htm

 また、pdftkコマンドラインを使って作業しますので、元のPDFファイルや新規PDFファイル
 のパスにスペースが含まれていると作業できませんので、場合によってはパスを「""""」で
 囲ってやる、ということも必要になります。パスにスペースが無くてもパスを「""""」で囲
 むとエラーになる、ということは有りませんので常にパスを「""""」で囲む、でもOK(のはず)
 です。
（田吾作） 2014/02/27(木) 00:08

コメント返信：

[ 一覧(最新更新順) ]

[[20140225111033]] 『PDFファイルのページを指定してシート貼付け』（田吾作） ページの最後に飛ぶ

[[20140225111033]]　『PDFファイルのページを指定してシート貼付け』（田吾作）　ページの最後に飛ぶ