質問: CombinePDF(p1, p2, SaveFileName) ' PDFファイルのハンドルを解放する FreePDF (p1) FreePDF (p2) ### 試したこと Acrobatから結合するプログラムも検索して出てきたのですが エラーになってしまい、使えませんでした。 ### 補足情報(言語/FW/ツール等のバージョンなど) より詳細な情報 Word2010 Excel2010
回答: 既にExcel.Workbookを型として宣言していましたので、Excel Object Libralyは参照設定に追加いただいているものと思いますので、その前提で。 PDFの読み込み~加工部分に関しては環境がないのでそのまま動くものとして、Excelループ部分のみアドバイスさせていただきます。 セル値の参照 Excelのセル値を参照する場合、まずブックを開き、そのブックに含まれるワークシートを指定して、その中のセル座標を指定して値を参照します。 `Workbook.Worksheets("シート名").Cells(行番号, 列番号)` なお、列番号の指定は通常は数値指定ですが、A列なら"A"などのアルファベット文字列でも指定できます。 プログラム的には数値指定の方が扱いやすいですが、見る人にはアルファベット指定の方がやさしいかもしれません。 状況によって使い分けてください。 また、セルの参照にRangeを使う人も多いですが、セル範囲ではなく単一セルを扱う場合にはCells(row, col)のほうが扱いやすいと思います。 ループ範囲 コード中のループ範囲は2~4行で作成しかけているようですが、おそらく本来はA列で値が入力されている範囲をループしたいのではないかと推測します。 A列のデータがある最終行を探す方法は、Excel上での操作だとA列に入力可能な最下行(Excel2010では1048576行目)からCtrl+↑を押すことで特定できます。 これをVBA的に記述するとCells(Rows.Count, "A").End(xlUp)という記述になります。 これで見つけたセルの行までループしてあげればいいと思います。 以下、サンプルです。 ``` Sub test() 'Excelを起動する Set app = CreateObject("Excel.Application") 'abc.xlsを開く Dim book As Excel.Workbook Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx") 'ファイル名一覧シートを指定 Dim sht As Excel.Worksheet Set sht = book.Sheets("Sheet1") For r = 2 To sht.Cells(Excel.Rows.Count, "A").End(xlUp).Row '行を2から最終行まで If sht.Cells(r, "A").Value <> "" Then 'A列注目行の値が""でなければ 'C列からファイル名を取得する mypdf = sht.Cells(r, "C").Value ChDir ThisDocument.Path 'Wordファイルと同じフォルダ If mypdf <> "" Then Documents.Open FileName:=mypdf End If PDF1 = mypdf ' 拡張子をtmpに変換する tmp1 = Replace(PDF1, ".pdf", ".tmp", Compare:=vbTextCompare) tmp2 = Replace(PDF2, ".pdf", ".tmp", Compare:=vbTextCompare) ' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する Call ChangePDFVersion(PDF1, tmp1) Call ChangePDFVersion(PDF2, tmp2) ' PDFファイルを読み込んでハンドルを取得する p1 = LoadPDF(tmp1) p2 = LoadPDF(tmp2) ' PDFファイルを結合する Result = CombinePDF(p1, p2, SaveFileName) ' PDFファイルのハンドルを解放する FreePDF (p1) FreePDF (p2) End If Next End Sub ``` コメントを受けて追記 やりたいこととしては、 1ファイル1を取得 2ファイル2を取得してファイル1に結合 ⇒結合ファイルが作成される 3ファイル3を取得して前回の結合ファイルに結合 ⇒結合ファイルが更新される というかんじであっていますでしょうか? 上記であれば、プログラムでも 1ループ1周目:ファイル1を取得 2ループ2周目:ファイル2を取得してファイル1に結合 ⇒結合ファイルを作成する 3ループ3周目以降:ファイル3を取得して前回の結合ファイルに結合 ⇒結合ファイルが更新される というように1ファイル目・2ファイル目と3ファイル目以降でPDF取得処理を分岐してあげることで実現できそうな気がします。 (PDF加工の部分がブラックボックスなので断言はできませんが。) 以下、修正したサンプルです。 ``` Sub test2() 'Excelを起動する Set app = CreateObject("Excel.Application") 'abc.xlsを開く Dim book As Excel.Workbook Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx") 'ファイル名一覧シートを指定 Dim sht As Excel.Worksheet Set sht = book.Sheets("Sheet1") Dim AddCnt As Integer AddCnt = 0 For r = 2 To sht.Cells(sht.Rows.Count, "A").End(xlUp).Row '行を2から最終行まで If sht.Cells(r, "A").Value <> "" Then 'A列注目行の値が""でなければ 'C列からファイル名を取得する mypdf = sht.Cells(r, "C").Value ChDir ThisDocument.Path 'Wordファイルと同じフォルダ If mypdf <> "" Then Documents.Open FileName:=mypdf 'カウンタ+1 AddCnt = AddCnt + 1 If AddCnt = 1 Then '1ファイル目の場合 ' PDFファイルを読み込んでハンドルを取得する p1 = MakeTemp(mypdf) ElseIf AddCnt = 2 Then '2ファイル目の場合 ' PDFファイルを読み込んでハンドルを取得する p2 = MakeTemp(mypdf) ' PDFファイルを結合する Result = CombinePDF(p1, p2, SaveFileName) ' 結合したPDFファイルのハンドルを解放する FreePDF (p1) FreePDF (p2) '次回のベースファイルとして結果PDFをオープン p1 = MakeTemp(SaveFileName) Else '3ファイル目以降の場合 ' PDFファイルを読み込んでハンドルを取得する p2 = MakeTemp(mypdf) ' PDFファイルを結合する Result = CombinePDF(p1, p2, SaveFileName) ' 結合したPDFファイルのハンドルを解放する FreePDF (p2) End If End If End If Next ' 結果PDFファイルのハンドルを解放する FreePDF (p1) 'ブックを閉じる book.Close End Sub 'tmp作成~PDF読込 Function MakeTemp(ByVal vsPDF As String) As Long Dim p As Long p = 0 ' 拡張子をtmpに変換する tmp = Replace(vsPDF, ".pdf", ".tmp", Compare:=vbTextCompare) ' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する Call ChangePDFVersion(vsPDF, tmp) ' PDFファイルを読み込んでハンドルを取得する p = LoadPDF(tmp) MakeTemp = p End Function ``` ※tmpの作成~PDF読込の部分は、複数個所で繰り返し使用しているため関数にしました。