この記事の続き

Excel VBA Just PDF4 または Adobe.Acrobatで複数のPDFファイルを結合させるのうち、pdf化する部分だけを関数化したもの

ExcelのPDF化の注意点

透過画像

透過画像が黒くなる場合上がるため、PDF/Aに準拠のチェックを外す。

ページは縮小率ではなく、縦Nページ、横Nページというように、ページを決める。

　1ページであっても、縦1ページ、横1ページと定義する。
　こうしないと、勝手に2ページになる場合がある。
　少なくともOfficeの機能でPDF化するなら、ページのレイアウトを決めておくほうが良い。

目的と仕様

連続する複数のファイルを順次PDF化する
PDFはもとのファイルがあるフォルダに作成する
Excelの場合、すべてのシートをPDF化する。順番は左から右らしい
Wordの場合、すべてのページをPDF化する。
一度PDF化したファイルは削除する。
PDFの名前はもとのファイル.xlsxならもとのファイル.pdfとなる。既存のもとのファイル.pdfは削除する。
このため、ExcelやWord、PDFが混在する場合、名前が必ずユニークでなければならない。

A.pdf A.docx A.xlsxは同じフォルダに混在することができる。
しかし、この関数はA.docxをPDF化するときにA.pdfを削除して、A.docxのPDFであるA.pdfを作成する。A.pdfは削除されてしまう。

なるべくPDF化したいファイルを一箇所のフォルダに集めてください。その場合、もとのファイルは必ず残した上でそのフォルダに集めてください。

Acrobatは不要
OfficeのExport機能を使用するので、Acrobatはいらない。
ちなみにこの機能は印刷としてもExportとしても名前をつけて保存でPDFを選んでも同じ。~~一つの機能を使いまわして多機能に見せかけているだけである。~~
Excelについての長所と欠点
- 長所
  写真を貼り付けたExcelの場合、スクリーン表示用を選択しても印刷はさほど劣化しない。この機能を使うと、画像を貼り付けたExcelファイルの容量が少なくなる。
- 短所
  PDF/AオプションがVBAで制御できない。一般的にそのチェックを外しておくこと。そうしないと透過画像が失敗する。
  罫線が細くなったり、画像が微妙にゆがむ時がある。Lightにするとどうしても画像がぼやける。
Word Excel WSH FSOは参照設定すること

課題

不安定さがまだ残っている。
仕掛けとしてはメインのプロシージャで拡張子でファイルのフォーマットを判定し、関数に送り、PDF化し、できたら別の列にファイル名を書く。
そうするとファイルを開いて、PDFに出力する、というもの。
成功するとファイル名が返ってくる。失敗すると空白が返る。

' 要参照設定
' ファイルが存在するフォルダに同名のPDFファイルを保存する。
' 同名のファイルがあれば削除される。
' このため拡張子が異なるが、ファイル名が同じならば、どちらか一方しかPDFにならない。
' Word Excel
' 同名のファイルはPDF化できない。どちらかが削除される
Function xl97toPDF(strFile As String) As String
On Error Resume Next
Dim wb1 As Workbook, stPDF As String
Dim fso As New Scripting.FileSystemObject
Dim strPath As String
strPath = fso.GetParentFolderName(strFile)
Set wb1 = Excel.Application.Workbooks.Open(strFile, False, True, , "", "", True, , , False, False, , False): DoEvents
  If Err.Number <> 0 Then
    Debug.Print strFile & " not open. ", Err.Number, Err.Description
    Err.Clear
  Else
    strPDf = fso.BuildPath(strPath, fso.GetBaseName(strFile) & ".PDF")
     If Dir(strPDf) <> "" Then Kill strPDf
    wb1.Activate
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
      strPDf, Quality:= _
      xlQualityMinimum, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
      OpenAfterPublish:=False: DoEvents
    wb1.Close False: DoEvents
    Set wb1 = Nothing
   xl97toPDF = strPDf
   Exit Function
  End If
On Error GoTo 0
If Err.Number <> 0 Then GoTo Err_
Exit Function
Err_:
   xl97toPDF = ""
End Function

' Excel 2007 Format
Function xl2007toPDF(strFile As String) As String
On Error Resume Next
Dim wb1 As Workbook, stPDF As String
Dim fso As New Scripting.FileSystemObject
Dim strPath As String
strPath = fso.GetParentFolderName(strFile)
Set wb1 = Excel.Application.Workbooks.Open(strFile, False, True, , "", "", True, , , False, False, , False): DoEvents
  If Err.Number <> 0 Then
    Debug.Print strFile & " not open. ", Err.Number, Err.Description
    Err.Clear
  Else
    strPDf = fso.BuildPath(strPath, fso.GetBaseName(strFile) & ".PDF")
     If Dir(strPDf) <> "" Then Kill strPDf
    wb1.Activate
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
      strPDf, Quality:= _
      xlQualityMinimum, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
      OpenAfterPublish:=False: DoEvents
    wb1.Close False: DoEvents
    Set wb1 = Nothing
    xl2007toPDF = strPDf
    Exit Function
  End If
On Error GoTo 0
If Err.Number <> 0 Then GoTo Err_
xl2007toPDF = ""
Exit Function
Err_:
Err.Clear
xl2007toPDF = ""
End Function
' Word 97 doc Format
Function word97toPDF(strFile As String) As String
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim strPDf As String
Dim fso As New Scripting.FileSystemObject
Dim strPath As String
Dim WSH As New IWshRuntimeLibrary.WshShell
strPath = fso.GetParentFolderName(strFile)
WSH.CurrentDirectory = strPath
'On Error Resume Next
ChangeFileOpenDirectory strPath
Set wDoc = wApp.Documents.Open(strFile, False, True, False, "", "", False, "", "")
  If Err.Number <> 0 Then
    Debug.Print Err.Number, Err.Description
    Err.Clear
   Set wDoc = wApp.Documents.Open(strFile, False, True, False, "", "", False, "", "", wdOpenFormatAuto): DoEvents
  End If
  If wDoc Is Nothing Then
  Set wDoc = Word.Application.Documents.Open(strFile, False, True)
  End If
  On Error GoTo 0
  strPDf = fso.BuildPath(strPath, fso.GetBaseName(strFile) & ".PDF")
  If Dir(strPDf) <> "" Then Kill strPDf
  'wDoc.ExportAsFixedFormat2 strFile, wdExportFormatPDF, False, wdExportOptimizeForOnScreen, wdExportAllDocument, , , wdExportDocumentWithMarkup, True, False, wdExportCreateWordBookmarks, True, True, False, True: DoEvents
  'wDoc.ExportAsFixedFormat strPDf, wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument, , , wdExportDocumentContent, False, False, , , True, False: DoEvents
  wDoc.ExportAsFixedFormat strPDf, wdExportFormatPDF: DoEvents
  wDoc.Close False
  word97toPDF = strPDf
On Error GoTo 0
If Err.Number <> 0 Then GoTo Err_
word97toPDF = ""
Exit Function
Err_:
word97toPDF = ""
End Function
' Word 2007 Later docx format
Function Word2007toPDF(strFile As String) As String
Dim wDoc As Word.Document
Dim wApp As Word.Application
Dim strPDf As String
Dim fso As New Scripting.FileSystemObject
Dim strPath As String
Dim WSH As New IWshRuntimeLibrary.WshShell
strPath = fso.GetParentFolderName(strFile)
WSH.CurrentDirectory = strPath
'ChangeFileOpenDirectory strPath
'On Error Resume Next
  strPDf = fso.BuildPath(strPath, fso.GetBaseName(strFile) & ".PDF")
  If Dir(strPDf) <> "" Then Kill strPDf
'   ChangeFileOpenDirectory strPath ' NetWorkFolder Path Failed
  Set wDoc = Word.Application.Documents.Open(strFile, False, False, False, "", "", False, "", "", wdOpenFormatAuto, , False, True): DoEvents

  If wDoc Is Nothing Then
  Set wDoc = Word.Application.Documents.Open(strFile, False, True, False, , , , , , wdOpenFormatDocument)
  End If
  If wDoc Is Nothing Then
      Set wDoc = Word.Application.Documents.Open( _
        strFile, False, False, False, , , False, , , wdOpenFormatAuto)

  Set wDoc = Word.Application.Documents.Open(strFile, False, False, False, , , , , , wdOpenFormatAllWord)
  End If
  wDoc.ExportAsFixedFormat strPDf, wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportAllDocument, , , wdExportDocumentContent, False, False, , , True, False: DoEvents
  wDoc.Close False: DoEvents
  Word2007toPDF = strPDf
On Error GoTo 0
If Err.Number <> 0 Then Err.Clear
Word2007toPDF = ""
Exit Function
End Function