写しPDF作成マクロ～(4) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

クラスを組み合わせる

使用したクラス

それぞれのクラスの詳細については、リンク先をどうぞ。

標準モジュールのコード

Option Explicit

Public Type myFolder
  fdPath As String
  fdName As String
  fdIsExist As Boolean
  fdIsCreated As Boolean
End Type

Public Const SAVE_FOLDER As String = "写しPDF"

Public fng As FileNameGetter
Public scm As StampedCopyMaker
Public fc As FolderCreator
Public dpc As DocPdfConverter
Public ec As ErrorCatcher

Public Sub voidMain()
  Set scm = New StampedCopyMaker
  With scm
    'Wordドキュメントをセットする
    .setDocument (Range("DocumentPath").Value)    '……(1)'
    If .isFailed = True Then    '……(2)'
      Call showFailure(.objWord, .objDoc, .causeOfFail)    '……(3)'
      Exit Sub
    End If
    '写しハンコを捺す
    .createCopyWithStamp (Range("ImageFilePath").Value)    '……(4)'
    If .isFailed = True Then    '……(5)'
      Call showFailure(.objWord, .objDoc, .causeOfFail)
      Exit Sub
    End If
    'PDF保存用のフォルダの有無をチェックし、なければ作る
    Set fc = New FolderCreator
    fc.createFolder scm.objDoc.path, SAVE_FOLDER    '……(5)'
    If fc.objFolder.fdIsCreated = True Then    '……(6)'
      .objWord.Visible = False
      MsgBox "このフォルダ内に「" & SAVE_FOLDER & "」フォルダを作成しました。", _
             vbInformation
    End If
    If fc.hasError = True Then    '……(7)'
      Set ec = New ErrorCatcher
      ec.showError "FolderCreatorクラスのcreateFolderメソッド", True    '……(8)'
      Set ec = Nothing
    End If
    Set fc = Nothing
    'WordドキュメントをPDF化して保存する
    Set dpc = New DocPdfConverter
    dpc.convertDocToPDF .objDoc, SAVE_FOLDER, "【写】"    '……(9)'
    Set dpc = Nothing
    '元のWordドキュメントを閉じてWordを終了
    .objWord.Visible = False
    .objDoc.Close False
    If .objWord.Documents.Count = 0 Then
      .objWord.Application.Quit
    End If
    MsgBox "写しPDFを作成し、「写しPDF」フォルダに保存しました。"
  End With
  Set scm = Nothing
End Sub

Public Sub showFailure(ByRef wd As Word.Application, _
                       ByRef doc As Word.Document, _
                       ByVal message As String)
  wd.Visible = False
  If message <> "" Then
    MsgBox message, vbCritical
  End If
    MsgBox "    　＿＿＿＿＿＿＿＿_" & vbCrLf & _
           "　 ／　　　　　　　　         ＼ " & vbCrLf & _
           "／　／・＼　　／・＼　  　    ＼" & vbCrLf & _
           "|　　￣￣　　　￣　　 　　        |　ち～んｗ" & vbCrLf & _
           "|　　　　（＿人＿）　　 　         |" & vbCrLf & _
           "|　　　　　＼ 　   |   　    　   　|" & vbCrLf & _
           "＼　　　　 　＼＿|　　          ／"
  If Not doc Is Nothing Then
    doc.Close False
  End If
  If Not wd Is Nothing Then
    If wd.Documents.Count = 0 Then
      wd.Quit
    End If
  End If
End Sub

コードの説明

(1)。まずはStampedCopyMakerクラスのsetDocumentメソッドで元になるWordドキュメントをセット。
(2)。(1)が失敗していたら、StampedCopyMakerクラスのisFailedプロパティがTrueになるので、その場合は(3)でshowFailureメソッドを実行。
(4)。createCopyWithStampメソッドで、まずはWordドキュメントにハンコ画像を追加。
(5)で、FolderCreatorクラスのcreateFolderを用いて保存用フォルダの有無を調べ、なかったら新たに作る。
(6)。新たにフォルダを作った場合は、FolderCreatorクラスのobjFolder.fdIsCreatedプロパティがTrueになるので、新たにフォルダを作成した旨、メッセージを表示する。
フォルダ作成の過程でエラーが発生していたらhasErrorプロパティがTrueになっているので、(8)でErrorCatcherクラスのshowErrorメソッドを用いてエラー発生についてユーザに知らせる。
(9)では、DocPdfConverterクラスのconvertDocToPDFメソッドを用いてWordドキュメントをPDF化して保存。
以下、Wordドキュメントを保存せずに閉じて、Word.Applicationを終了している。

ざっとこんな感じ。