Q&A
###前提・実現したいこと
VBA初心者です。宜しくお願い致します。
WordVBAにてRTFファイルをPDF化した複数のファイルをExcelのファイル一覧表の並び
通りに結合したいです。
2つのPDFファイル結合は【pdftool.dll】
にて下記のコードでできるのですが、100ファイル以上を結合したいのです。
Public Declare Function CombinePDF Lib "pdftool.dll"
(ByVal PDF1 As Long, ByVal PDF2 As Long, ByVal SaveFileName As String) As Long
出来れば、VBAにてループ処理で行いたいです。
###該当のソースコード(2017/06/08追加しました)
' PDFDesigner Tools API
Public Declare Function LoadPDF Lib "pdftool.dll" (ByVal OpenFileName As String) As Long
Public Declare Sub FreePDF Lib "pdftool.dll" (ByVal PDF As Long)
Public Declare Function CombinePDF Lib "pdftool.dll" (ByVal PDF1 As Long, ByVal PDF2 As Long, ByVal SaveFileName As String) As Long
' PDFのバージョンを1.4形式にする(コピーしたファイルを編集)
Public Sub ChangePDFVersion(ByVal OpenFileName As String, ByVal SaveFileName As String)
Dim Stream() As Byte ' ストリーム
Dim FileNo As Integer ' ファイルNO
' ファイルを読み込む
FileNo = FreeFile
ReDim Stream(FileLen(OpenFileName) - 1)
Open OpenFileName For Binary As #FileNo
Get #FileNo, , Stream
Close #FileNo
' PDFの形式を1.4にする
Stream(5) = "&H31": Stream(7) = "&H34"
' ファイルの出力
FileNo = FreeFile
Open SaveFileName For Binary Access Write As #FileNo
Put #FileNo, , Stream
Close #FileNo
End Sub
'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")
For r = 2 To 4 '行を1から4まで
If Range("A" & r).Value <> "" Then 'A列注目行の値が""なら
mypdf = Range("C" & i + 1).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)
###試したこと
Acrobatから結合するプログラムも検索して出てきたのですが
エラーになってしまい、使えませんでした。
###補足情報(言語/FW/ツール等のバージョンなど)
より詳細な情報
Word2010
Excel2010
回答1件
0
ベストアンサー
既にExcel.Workbookを型として宣言していましたので、Excel Object Libralyは参照設定に追加いただいているものと思いますので、その前提で。
PDFの読み込み～加工部分に関しては環境がないのでそのまま動くものとして、Excelループ部分のみアドバイスさせていただきます。
セル値の参照
Excelのセル値を参照する場合、まずブックを開き、そのブックに含まれるワークシートを指定して、その中のセル座標を指定して値を参照します。
Workbook.Worksheets("シート名").Cells(行番号, 列番号)
なお、列番号の指定は通常は数値指定ですが、A列なら"A"などのアルファベット文字列でも指定できます。
プログラム的には数値指定の方が扱いやすいですが、見る人にはアルファベット指定の方がやさしいかもしれません。
状況によって使い分けてください。
また、セルの参照にRangeを使う人も多いですが、セル範囲ではなく単一セルを扱う場合にはCells(row, col)のほうが扱いやすいと思います。
ループ範囲
コード中のループ範囲は２～４行で作成しかけているようですが、おそらく本来は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
コメントを受けて追記
やりたいこととしては、
①ファイル１を取得
②ファイル２を取得してファイル１に結合 ⇒結合ファイルが作成される
③ファイル３を取得して前回の結合ファイルに結合 ⇒結合ファイルが更新される
というかんじであっていますでしょうか？
上記であれば、プログラムでも
①ループ１周目：ファイル１を取得
②ループ２周目：ファイル２を取得してファイル１に結合 ⇒結合ファイルを作成する
③ループ３周目以降：ファイル３を取得して前回の結合ファイルに結合 ⇒結合ファイルが更新される
というように１ファイル目・２ファイル目と３ファイル目以降で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 'カウンタ＋１ AddCnt = AddCnt + 1 If AddCnt = 1 Then '１ファイル目の場合 ' PDFファイルを読み込んでハンドルを取得する p1 = MakeTemp(mypdf) ElseIf AddCnt = 2 Then '２ファイル目の場合 ' PDFファイルを読み込んでハンドルを取得する p2 = MakeTemp(mypdf) ' PDFファイルを結合する Result = CombinePDF(p1, p2, SaveFileName) ' 結合したPDFファイルのハンドルを解放する FreePDF (p1) FreePDF (p2) '次回のベースファイルとして結果PDFをオープン p1 = MakeTemp(SaveFileName) Else '３ファイル目以降の場合 ' 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読込の部分は、複数個所で繰り返し使用しているため関数にしました。
投稿2017/06/07 01:55
編集2017/06/07 08:14
総合スコア3013
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/06/07 04:40
2017/06/07 08:19
2017/06/08 04:09
2017/06/08 07:34 編集
2017/06/08 07:10
2017/06/08 08:16
2017/06/09 01:12
2017/06/09 01:29 編集
2017/06/09 01:46
2017/06/09 08:06
2017/06/12 02:02
2017/06/12 05:03
2017/06/12 07:18