Takuya Miyashita

Word文書を開いてpdfへ変換 †

概要 †

Word マクロだけで PDF 変換をしようとすると，文書を毎回手作業で開くことになると思う．
Excel でファイルのリストを作成し，自動で MS Word のアプリケーションとファイルを開くようにすれば，一括で複数の PDF に…と思ったのがきっかけ.
変換が実行できる Excel ファイルも含め, GitHub にアップロードした.
テスト用の Word ファイルがリポジトリに置いてあり，clone したら .xlsm ファイルを開いてボタンを押すだけで試せる．

あまり洗練されていないので，うまく動作しない等あったら教えてください． tips (at mark) hydrocoast.jp

Prerequisite †

まず，VBA で Word を展開し，(PDF に必要な) Acrobat を使用するには，VBE の画面から
ツール→参照設定　で

• Microsoft Word x.x Object Library
  
• Adobe Acrobat x.x Type Library
  

へのチェックが必要(だと思う)．下のスクリーンショットの通り．



有効にできない時は，PC に Acrobat (Reader) 自体がないかライブラリ等が不足している可能性があるのでインストールが必要．

変換方法 †

メインのシートは下の写真．

3つあるうちの一番上のボタンでファイルをリストアップして，下のボタンで変換を開始する．

そのうち README をちゃんと書きたい．
主要な処理となるコードは下記の通り.

Sub MSWord2PDF(objWord, docname, pdfname)
    Dim openDoc As Word.Document
   
    ' In order to activate the relative path
    objWord.ChangeFileOpenDirectory ThisWorkbook.Path
    
    'Open MSWord Document (ReadOnly)
    Set openDoc = objWord.Documents.Open(Filename:=docname, ReadOnly:=True)
        
    '**** Convert the Document to PDF ****
    openDoc.ExportAsFixedFormat _
        OutputFileName:=pdfname, _
        ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, _
        OptimizeFor:=wdExportOptimizeForPrint, _
        Range:=wdExportAllDocument, _
        Item:=wdExportDocumentContent, _
        IncludeDocProps:=True, _
        KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, _
        DocStructureTags:=True, _
        BitmapMissingFonts:=True, _
        UseISO19005_1:=False

    'Close the document
    openDoc.Close SaveChanges:=False
End Sub

読み取り専用でWordを開かないと，既に誰かが開いていた時に手間が必要になる．
openDoc.ExportAsFixedFormat 以下のキーワード引数を変更することで，詳細な形式の設定ができる.
また，

objWord.ChangeFileOpenDirectory ThisWorkbook.Path

の部分で相対パスでの入出力を有効にしている. Wordファイルを展開するときのパスは，ChDrive と ChDir をしても意味がなかった．

呼び出すルーチン,その他のコード †

上記のSubの入力引数はそれぞれ

Dim objWord As Word.Application
Dim docname, pdfname As String

の型の入力が必要.
メインルーチンその他を以下のように書いた.
既にWordが開かれている状態だと処理が面倒なので，現状ではWordを全て閉じてからでないと実行できないようにしている.

Sub Main()
    Dim SheetName1, SheetName2 As String
    Dim WS As Worksheet
    Dim nfile, chk As Long
    Dim i As Long

    ' Path
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
    'Stop Screen Updating
    'Application.ScreenUpdating = False

    ' Parameters
    SheetName1 = "IO"
    SheetName2 = "FileConfig"
  
    ' Initial Setup
    Set WS = ThisWorkbook.Worksheets(SheetName1)
    nfile = WS.Range("B1").End(xlDown).row - 1
    chk = WS.Range("C1").End(xlDown).row - 1
  
    ' Check 1
    If nfile > 100 Then
        MsgBox "No file to be converted" + vbCrLf
        Exit Sub
    End If
          
    ' Check 2
    If chk <> nfile Then
        MsgBox "Error: Invalid number of I/O file"
        Exit Sub
    End If

    ' Check 3
    Dim ChkObj As Object
    On Error Resume Next
    Set ChkObj = GetObject(, "Word.Application")
    On Error GoTo 0
    If Not ChkObj Is Nothing Then
        MsgBox "Error: Close MS Word application before this procedure"
        Exit Sub
    End If
    ''''''Call CloseMSWordAll

    'Start Word Application
    Dim objWord As Word.Application
    Set objWord = CreateObject("Word.Application")
    With objWord
         ' Keep displayed
         '.Visible = True
         ' Or hidden'
         .Visible = False
    End With
       
    'Convert each file
    For i = 1 To nfile
        Call SetFileInfo(SheetName1, i + 1, 2, SheetName2, 2, 3)
        Call SetFileInfo(SheetName1, i + 1, 3, SheetName2, 3, 3)
        'Convert to PDF'
        Call Convert(objWord)
    Next i
    
    'Activate Screen Updating
    '''Application.ScreenUpdating = True
   
    'Close the application
    objWord.Quit
   
    MsgBox "おわり"
End Sub

Sub SetFileInfo(ISheet, Irow, Icol, OSheet, Orow, Ocol)
    Dim IWS, OWS As Worksheet
    Set IWS = ThisWorkbook.Worksheets(ISheet)
    Set OWS = ThisWorkbook.Worksheets(OSheet)
    OWS.Cells(Orow, Ocol).Value = IWS.Cells(Irow, Icol).Value
End Sub

Sub GetFileName(str1, str2)
    Dim MainWS As Worksheet
    Set MainWS = ThisWorkbook.Worksheets("FileConfig")
    str1 = MainWS.Cells(2, 3).Value
    str2 = MainWS.Cells(3, 3).Value
End Sub

Sub Convert(objWord)
    Dim docname, pdfname As String
    Call GetFileName(docname, pdfname)
    Call MSWord2PDF(objWord, docname, pdfname)
End Sub

詳細な解説は省くが，Excel シートのセル上に Word 文書のファイル名と変換後の PDF ファイル名を入力し，列挙したものから順番に変換されていく仕組みである.
上記 GitHub のリンク先の Excel ファイル(.xlsm)で確認できる.