読者です 読者をやめる 読者になる 読者になる

写しPDF作成マクロ~(4)

VBAクラス・モジュール VBA一般

クラスを組み合わせる

使用したクラス

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

標準モジュールのコード

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 & _
           "|   ̄ ̄    ̄             | ち~んw" & 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を終了している。

ざっとこんな感じ。

おわりに

他にも、リボンの表示/非表示を切り替えるコードとか、FileNameGetteクラスを使って、Wordドキュメントのフルパスとか、ハンコ用画像ファイルのフルパスを取得するコードなんかもあるけど、割愛。

あまり便利とかそういうのはないけど、こんなこともできますよ、ということで……。

@akashi_keirin on Twitter

クラスをクラスのフィールドにする

VBAクラス・モジュール VBA覚書

クラスをクラスのフィールドにする

クラスを丸ごとクラスのフィールドにしたらいいんじゃないか、と今さらながらに気がついた。Javaの本でさんざん目にしていたことなんだけど。

フィールド用のクラス

「GambleRacer」というクラスを作った。

クラスモジュールのコード

Option Explicit
'フィールド
Private name_ As String
Private racingStyle_ As String
Private racingPoints_ As Integer
'アクセサ
Public Property Get name() As String
  name = name_
End Property
Public Property Get racingStyle() As String
  racingStyle = racingStyle_
End Property
Public Property Get racingPoints() As Integer
  racingPoints = racingPoints_
End Property
'コンストラクタ

'メソッド
Public Sub setData(ByVal n As String, _
                   ByVal rs As String, _
                   ByVal rp As Integer)
  name_ = n
  racingStyle_ = rs
  racingPoints_ = rp
  MsgBox "データをセットしました。"
End Sub

Public Sub showMyself()
  MsgBox "私は" & name_ & "です。" & vbCrLf & _
         "得意戦法は" & racingStyle_ & "、" & vbCrLf & _
         "競走得点は" & racingPoints_ & "点です。"
End Sub

フィールドとして名前、戦法、競走得点の3つを持ち、メソッドとしてデータをセットするsetDataと、自己紹介をするshowMyselfの2つを持つクラス。

GambleRacerをフィールドに持つクラス

「KeirinRace」というクラスを作った。

クラスモジュールのコード

Option Explicit
'フィールド
Private gr_ As GambleRacer
'アクセサ
Public Property Get gr() As GambleRacer
  Set gr = gr_
End Property
'コンストラクタ

'メソッド
Public Sub setData(ByRef gr As GambleRacer)
  Set gr_ = gr
End Sub
Public Sub doKeirin()
  With gr_
    MsgBox .name & "の" & "渾身の" & .racingStyle & "が決まった!" & vbCrLf & _
           "さすが" & .racingPoints & "点レーサー!"
  End With
End Sub

フィールドとしてGambleRacerクラスを持ち、データをセットするsetDataと、競輪競走を行う(笑)doKeirinという2つのメソッドを持つクラスにした。

実行

標準モジュールに次のコードを書いて実行してみた。

標準モジュールのコード

Sub test()
  Dim kr As KeirinRace                 '……(1)
  Set kr = New KeirinRace              '……(2)
  Dim gr As GambleRacer                '……(3)
  Set gr = New GambleRacer             '……(4)
  gr.setData "中野 浩一", "捲り", 120  '……(5)
  gr.showMyself                        '……(6)
  kr.setData gr                        '……(7)
  kr.doKeirin                          '……(8)
  Set gr = Nothing
  Set kr = Nothing
End Sub

コードの説明

説明することに意義があるかどうかは不明なれど……。

  • (1)でKeirinRaceクラスの変数を準備。
  • (2)でKeirinRaceクラスのインスタンスを生成。
  • (3)でGambleRacerクラスの変数を準備。
  • (4)でGambleRacerクラスのインスタンスを生成。
  • (5)で、GambleRacerクラスのsetDataメソッドを用いて各データをセット。こんなの、本来コンストラクタでやることですが。
  • (6)で、GambleRacerクラスのshowMyselfメソッドを用いて自己紹介させる。
  • (7)で、KeirinRaceクラスのsetDataメソッドを用いてデータをセット。引数としてGambleRacerクラスのインスタンスを渡している。
  • (8)で、KeirinRaceクラスのdoKeirinメソッドを実行。

実行結果

f:id:akashi_keirin:20170321225827j:plain

GambleRacerクラスのsetDataメソッドが実行された証。

f:id:akashi_keirin:20170321225834j:plain

GambleRacerクラスのshowMyselfメソッドが実行された。

f:id:akashi_keirin:20170321225842j:plain

KeirinRaceクラスのdoKeirinメソッドも無事実行された。

おわりに

ちょっと今まで「クラスの独立性」という概念を勘違いしていたのかも。まだまだ勉強が足りませんな。

小さなクラスを作る(6)~WordドキュメントをPDFに変換する

小さなクラス ちょい書きマクロ VBAクラス・モジュール

WordドキュメントをPDFに変換して保存する

仕様

  • Wordドキュメント
  • そのWordドキュメントがあるフォルダパス
  • ファイル名

以上3つをフィールドとして持つ。

メソッドは今のところ一つだけ。

  • WordドキュメントをPDFにして指定のフォルダに保存する
  • 元のWordドキュメントのあるフォルダにある保存用のフォルダに保存する
  • 元のWordドキュメントのファイル名に任意の文字列を追加することができる

とまあ、こんな感じにした。

クラスモジュールのコード

オブジェクト名は「DocPDFConverter」とした。

フィールド部分
Option Explicit
'フィールド
Private objDoc_ As Word.Document
Private objPath_ As String
Private objFileName_ As String
アクセサ部分
'アクセサ
Public Property Get objDoc() As Word.Document
  Set objDoc = objDoc_
End Property
Public Property Get objPath() As String
  objPath = objPath_
End Property
Public Property Get objFileName() As String
  objFileName = objFileName_
End Property
メソッド部分
'メソッド
Public Sub convertDocToPDF(ByRef doc As Word.Document, _
                           ByVal tgtFolderName As String, _
                           Optional ByVal addStr As String = "")  '……(1)
  Set objDoc_ = doc
  objPath_ = doc.path
  objFileName_ = doc.Name
  Dim nameStr As String                                           '……(2)
  nameStr = Left(objDoc_.Name, InStrRev(objDoc_.Name, ".") - 1)   '……(3)
  objDoc_.ExportAsFixedFormat _
    OutPutFileName:=objPath_ & "\" & tgtFolderName & "\" & addStr & nameStr & ".pdf", _
    ExportFormat:=wdExportFormatPDF                               '……(4)
  DoEvents
End Sub

コードの説明

  • (1)にあるように、引数は3つ。第1引数はWordドキュメントそのもの。第2引数は保存用のフォルダ名。第3引数は保存時にファイル名の先頭に加える文字列。Optionalなので省略可。
  • (2)は、拡張子を除いたファイル名を入れるための変数。
  • (3)で、拡張子を除いたファイル名を割り出す。
  • (4)では、WordドキュメントオブジェクトのExportAsFixedFormatメソッドでPDFに変換・保存している。引数OutPutFileNameとExportFormatを指定して実行している。それぞれの引数が何を意味しているかは、コードを見たら分かると思う。

おわりに

なんだか、あんまりクラスにした意味が感じられないなあ。もっと柔軟な処理ができるようにした方がいいのかも。

まあ、でもこれで、写しPDF作成マクロに必要なものは出そろったので、ここらで写しPDF作成マクロシリーズに戻ることにしよう。

@akashi_keirin on Twitter

小さなクラスを作る(5)~エラーキャッチをするクラス

VBAクラス・モジュール 小さなクラス ちょい書きマクロ

エラーキャッチをするクラスを作る

そんなことをする意味があるのかどうかはともかく、エラー時にメッセージを表示させるという処理もよく使うので、作ってみた。まあ、何でもかんでもクラスを作っていったら、そのうちコツがつかめるだろうということで勘弁してくださいw

例によって、クラスモジュールを挿入して、名前は「ErrorCatcher」にした。

クラス「ErrorCatcher」のコード

フィールド部分
Option Explicit
'フィールド
Private processName_ As String
Private errorNumber_ As Integer
Private errorDescription_ As String
Private isNecessaryToProvoke_ As Boolean
アクセサ部分
'アクセサ
Public Property Get processName() As String
  processName = processName_
End Property
Public Property Get errorNumber() As Integer
  errorNumber = errorNumber_
End Property
Public Property Get errorDescription() As String
  errorDescription = errorDescription_
End Property
Public Property Get isNecessaryToProvoke() As Boolean
  isNecessaryToProvoke = isNecessaryToProvoke_
End Property
コンストラクタ部分

珍しく使いどころがあった。

'コンストラクタ
Private Sub Class_Initialize()
  errorNumber_ = Err.Number
  errorDescription_ = Err.Description
End Sub

このクラスのインスタンスが生成された時点でErrオブジェクトが持っているNumberとDescriptionをセットするようにした。ただ、このやり方だと、次のような問題が生ずる。すなわち、

  • エラーキャッチしようとするたびにインスタンス化し、終わったらすぐに破棄しないといけない
  • エラーが発生する場所に「On Error GoTo 0」を書いてはいけない

う~ん、こんなに約束事が多いんじゃ、使えないかなあ。

メソッド部分
'メソッド
Public Sub showError(ByVal errorPlace As String, _
                     Optional ByVal toProvoke As Boolean = False)      '……(1)
  processName_ = errorPlace
  MsgBox errorPlace & "で、" & vbCrLf & _
         "エラー番号:" & errorNumber_ & _
         "、「 " & errorDescription & "」エラーが発生しています。" & _
         vbCrLf & _
         "原因を確認して対応してください。", vbInformation             '……(2)
  If toProvoke = True Then                                             '……(3)
    MsgBox "     _________" & vbCrLf & _
           "  /           \ " & vbCrLf & _
           "/ /・\  /・\         \" & vbCrLf & _
           "|   ̄ ̄    ̄          | ち~んw" & vbCrLf & _
           "|    (_人_)         |" & vbCrLf & _
           "|     \     |              |" & vbCrLf & _
           "\      \_|        /", vbCritical
  End If
  Err.Clear                                                            '……(4)
End Sub
コードの説明
  • (1)。引数は2つ指定。第1引数はエラーが発生した場所を表す文字列。第2引数は、「煽り」を入れるかどうか。完全に遊びですw
  • (2)は、通常のエラー発生お知らせメッセージ。
  • (3)。第2引数でTrueが渡されていたら、ユーザを煽るw
  • (4)でErrオブジェクトをクリア。

実行

標準モジュールに、

Sub test()
  Set fc = New FolderCreator
  fc.createFolder ThisWorkbook.path, "spaghetti?"                      '……(1)
  If fc.hasError = True Then                                           '……(2)
    Set ec = New ErrorCatcher                                          '……(3)
    ec.showError "FolderCreatorクラスのcreateFolderメソッド", True     '……(4)
    Set ec = Nothing                                                   '……(5)
  End If
  Set fc = Nothing
End Sub

こんなコードを書いて実行してみた。

  • (1)で、不正な文字を使ったフォルダ名を指定
  • そうすると、FolderCreatorクラスのcreateFolderメソッドでエラーが出るはず
  • エラーが出たら、FolderCreatorクラスのインスタンスfcのhasErrorプロパティはTrueになる
  • そうなると、(2)の条件式がTrueになるので、
  • (3)でErrorCatchクラスのインスタンスecを生成して、
  • (4)でshowErrorメソッドを呼び出す
  • 第2引数をTrueにしているので、エラーが出たら煽られる

まあ、こうなるはず。

f:id:akashi_keirin:20170320084523j:plain

無事にエラー内容が表示され、

f:id:akashi_keirin:20170320084530j:plain

煽られたwww

おわりに

正直、こんなの必要なのかなあ、とは思う。

@akashi_keirin on Twitter

小さなクラスを作る(4)~フォルダ作成クラス

VBAクラス・モジュール 小さなクラス ちょい書きマクロ

きっかけ

写しハンコつきPDFを作るマクロのコードを見直していると、メインの「写しPDFを作るクラス」が結構複雑なクラスになっていることが分かった。ざっと挙げると、

  • 元のWordドキュメントに画像があるかどうかチェック
  • ハンコ用の画像ファイルが実在するかチェック
  • 各ページの先頭中央にハンコ画像を追加する
  • 保存用のフォルダの有無をチェックし、なければ作る
  • ハンコ画像付きのWordドキュメントをPDFに変換して保存
  • Wordドキュメントを閉じてWordを終了

とまあ、これだけのことを一つのクラスの一つのメソッドに請け負わせていたことになる。

こうやって改めて書き出してみたら、イマイチだなあ……、とw

たとえば、4つ目の保存先のフォルダの有無をチェックし、なければ作るなんてのは、他のマクロでも頻出の処理だし、5つ目のWordドキュメントをPDF化して保存なんてのも他で使い回せそうだ。

ということは、切り出して独立したクラスにしといた方が良いということだろう。

だから、やってみた。

フォルダの有無をチェックしてなければ作るクラス

例によってクラスモジュールを挿入。オブジェクト名は「FolderCreator」とした。

フィールド部分

Private objFolder_ As myFolder

ちょっと実験的に、フィールド部分を構造体にしてみた。

ただ、構造体の定義をクラスモジュールに書けたら分かりやすいんだけど、それはさせてもらえず、標準モジュールにPublicで書かざるを得なかった。

標準モジュールの宣言セクション

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 fc As FolderCreator

これがうまいやり方なのかどうかは分からないけど、

対象のフォルダが存在する

ということを表すんだったら、たとえば

fc.isExist = True


と書くよりも、

fc.objFolder.fdIsExist = True


と書く方が分かりやすいと思ったのだ。

ただ、構造体を定義する場所と実際に使う場所が離れてしまうので、保守性という点ではイマイチなのかも知れない。

アクセサ部分

'アクセサ
Public Property Get objFolder() As myFolder
  objFolder = objFolder_
End Property

構造体としてまとめた関係で、このように異様にシンプルになる。

メソッド部分

2つのメソッドを作ってみた。

'メソッド
Public Sub checkExistenceOfFolder(ByVal tgtPath As String, _
                                  ByVal folderName As String)  '……(1)
  With objFolder_
    .fdIsExist = False
    .fdPath = tgtPath
    .fdName = folderName
    If Dir(.fdPath & "\" & .fdName, vbDirectory) = "" Then     '……(2)
      .fdIsExist = False
    Else
      .fdIsExist = True
    End If
  End With
End Sub

Public Sub createFolder(ByVal tgtPath As String, _
                        ByVal folderName As String)            '……(3)
  With objFolder_
    .fdIsExist = False
    .fdIsCreated = False
    .fdPath = tgtPath
    .fdName = folderName
    If Dir(.fdPath & "\" & .fdName, vbDirectory) = "" Then
      MkDir .fdPath & "\" & .fdName                            '……(4)
      .fdIsCreated = True                                      '……(5)
      .fdIsExist = True
    Else
      .fdIsExist = True
    End If
  End With
End Sub

1つ目のcheckExistenceOfFolderメソッド(1)は、その名の通り、指定したフォルダが存在するかどうかを調べるメソッド。存在していたらfdIsExistプロパティにTrueが格納される。それだけ。使い道があるのかどうかは不明w

2つ目のcreteFolderメソッド(3)は、第1引数で指定したフォルダに、第2引数で指定した名前のフォルダがあるかどうかを調べて、なかったら作る、というもの。

コードの説明

  • (1)からのcheckExistenceOfFolderメソッド。(2)では、Dir関数を使ってフォルダが存在するかどうか調べている。引数で指定したフォルダが存在しなかったら、Dir関数は""を返す。これはよく使うと思う。
  • (3)からのcreteFolderメソッド。checkExistenceOfFolderメソッドと同じようにフォルダの有無を調べて、なかったら(4)でMkDirステートメントで新しいフォルダを作成している。
  • 新たにフォルダを作成した場合は、元々フォルダが存在していた場合と区別するために、(5)でobjFolderプロパティのfdIsCreated要素(擬似的なプロパティ)をTrueにする。

おわりに

構造体の使用の是非はともかく、

他で使い回せるかどうか

を基準に、クラスを切り分けていくのが良いのかもしれない。

@akashi_keirin on Twitter

平成29年3月20日追記

なずな (id:nazuna_0124)さんからのコメントを見て気がついた。

エラー対応がないんじゃね???

ということに。

だからといって、今さら上の方を書き改めるのはメンドクサイので、とりあえず現段階での「FolderCreator」クラスのコードだけ投げやりに載っけとこう。

クラスFolderCreatorのコード

Option Explicit
'フィールド
Private objFolder_ As myFolder
Private hasError_ As Boolean
'アクセサ
Public Property Get objFolder() As myFolder
  objFolder = objFolder_
End Property
Public Property Get hasError() As Boolean
  hasError = hasError_
End Property
'コンストラクタ

'メソッド
Public Sub checkExistenceOfFolder(ByVal tgtPath As String, _
                                  ByVal folderName As String)
  With objFolder_
    .fdIsExist = False
    .fdPath = tgtPath
    .fdName = folderName
    If Dir(.fdPath & "\" & .fdName, vbDirectory) = "" Then
      .fdIsExist = False
    Else
      .fdIsExist = True
    End If
  End With
End Sub

Public Sub createFolder(ByVal tgtPath As String, _
                        ByVal folderName As String)
On Error Resume Next
  Err.Clear
  hasError_ = False
  With objFolder_
    .fdIsExist = False
    .fdIsCreated = False
    .fdPath = tgtPath
    .fdName = folderName
    If Dir(.fdPath & "\" & .fdName, vbDirectory) = "" Then
      MkDir .fdPath & "\" & .fdName
      .fdIsCreated = True
      .fdIsExist = True
    Else
      .fdIsExist = True
    End If
  End With
  If Err.Number > 0 Then
    hasError_ = True
  End If
End Sub

いちおう説明

「hasError」というプロパティを加えた。エラーが発生していたら、Trueになるので、メソッドの呼び出し元で条件判定してエラー時の処理を書けばよい。エラー時の処理にはたぶんErr.Numberとか、Err.Descriptionを使うことになるだろうから、「On Error GoTo 0」は書いていない。

写しPDF作成マクロ~(3)―ページ先頭位置を割り出して画像を追加する―

VBA一般 VBA覚書 WordVBA

Wordドキュメントに画像を貼り付ける

今回作成するマクロでは、Wordドキュメントにpng画像を貼り付ける必要がある。しかも、その処理をExcelから行う、という無駄にややこしい仕様w

とりあえず、今回は

Wordドキュメントの各ページの先頭中央にpng画像を貼り付ける

ことに特化して書く。

ExcelVBA使いにとって、WordVBAって、

似ているのに何かちょっとクセがつかみづらい

気がするので、自身の覚書も兼ねてちょっとこってり書くよ。

やるべきこと

ひとまず、やるべきことを整理しておこうかね。

参考文献は土屋和人さんの『Wordマクロ/VBA徹底入門』という本。

WordVBA関連の情報ってホントに乏しくて、本屋で見つけて清水の舞台から飛び降りるつもりで定価購入した直後に敦賀ブックオフで500円ぐらいで売っていたのを見つけてずっこけたのは良い思い出だw

閑話休題

  1. ドキュメントの先頭を選択する
  2. png画像を貼り付ける(追加する)
  3. Wordの「検索」機能を用いて改ページ位置を割り出す
  4. 改ページ位置の次の場所を選択する
  5. 改ページが見つからなくなるまで繰り返し

とまあ、これだけのことをやらせればよい。

使用したコード

下に挙げるコードは、クラスのメソッドとして書いたものの抜粋。従ってよく分からん変数が使われていると思うので、先に説明しておく。

objRange

こいつは、WordのRangeオブジェクトを格納するための変数。

objDoc_

こいつは、クラス内で操作対象のWordのDocumentをセットしておくための変数。

imgPath

こいつは、このメソッドに渡される引数で、ハンコ用のpngファイルのフルパスが入っている。

まあ、これだけのことを頭に置いて、次のコードを読んでくだされ。

Dim objRange As Word.Range                                       '……(1)
Set objRange = objDoc_.Range(0, 0)                               '……(2)
objRange.Select                                                  '……(3)
Do
  objDoc_.Shapes.AddPicture fileName:=imgPath, _
                            Top:=0, _
                            Left:=200                            '……(4)
  With objWord_.Selection.Find                                   '……(5)
    .MatchWildcards = False                                      '……(6)
    .MatchFuzzy = False                                          '……(7)
    .Text = "^m"                                                 '……(8)
    .Execute Forward:=True                                       '……(9)
	End With
  Set objRange = objDoc_.Range(objWord_.Selection.End + 1, _
                               objWord_.Selection.End + 1)       '……(10)
    objRange.Select                                              '……(11)
Loop Until objWord_.Selection.Find.Found = False                 '……(12)

コードの説明

久しぶりに読んでみたら、すっかり意味を忘れていたのでw 復習も兼ねてしっかり説明しよう。

  • (1)は、WordのRangeオブジェクトを格納するための変数の準備。このコードはExcelのモジュールに書いているので、型を指定するときに「Word.Range」と書いているところが注意かな。
    ※実は、私、これでしばしハマりました。
  • (2)で、Wordドキュメントの0文字目~0文字目、つまり文書の先頭位置をobjRange_に格納している。
  • (3)で、その位置を選択している。
    f:id:akashi_keirin:20170319084940j:plain
  • (4)で、png画像を追加。AddPictureメソッドを使用。Topプロパティの「0」はともかく、Leftプロパティの「200」は完全に目分量。
  • いよいよ(5)からが本番。(5)~(9)の説明の前に画像をば。

f:id:akashi_keirin:20170319084955j:plain

スキルがないので、画像が汚くてすまん。そのうち勉強する。

赤で書き込んだのが今回使用するプロパティ。

  • (5)では、SelectionオブジェクトのFindプロパティを参照。Withしているので、ここから先はFindオブジェクトに対する操作。

最初はコレが分からなかった。「Find」なんて言ったらメソッドだと思うよねえ……。このFindオブジェクトというのは、
f:id:akashi_keirin:20170319084955j:plain
こいつのことなんだな。

  • (6)、(7)で、ワイルドカードとあいまい検索(日)をオフにしている。特にMatchFuzzyプロパティをFalseにしておかないと、この後の特殊文字の検索ができないので注意。
    ※ちなみにここでも相当長時間ハマりました。
  • (8)で検索する対象をセット。「^m」ってのは「改ページ」を表す特殊文字
  • ここまでで検索の設定ができたので、(9)で検索を実行。「execute」ってのは、「exeファイル」でおなじみ、「実行する」って意味だよね。
  • あと、Excecuteメソッドの引数「Forward」ってのは「次を検索」ってやつだな。

f:id:akashi_keirin:20170319085006j:plain

ちなみに、この時点で、「Selection」オブジェクトの「End」プロパティには「171」が入っていることが分かる。

f:id:akashi_keirin:20170319085016j:plain

Wordの方では、改ページ記号が選択されている。

  • (10)で、現在選択中の最後の場所の次の場所、すなわち、次のページの先頭を新たにobjRangeにセット。
  • (11)でその場所を選択。
    f:id:akashi_keirin:20170319085026j:plain
  • (12)は繰り返し判定。検索の結果、検索対象が見つかっていなければ、FindオブジェクトのFoundプロパティにFalseが返るので、その場合はループを抜ける、ということ。

おわりに

WordVBAって、いまいち使いどころがよく分からないけれど、このFindオブジェクトの使い方はしっかり身につけておいたら、いろいろ面白そうだ。

@akashi_keirin on Twitter

写しPDF作成マクロ~(2)

VBA一般 VBAクラス・モジュール WordVBA

ファイル選択用のクラスを作る

指定した拡張子のファイルを選択させる

今回のマクロでは、写し作成元のWordファイル、ハンコ用のpngファイル、と、ファイル形式を限定して取得したい。そうすると、ファイル選択ダイアログでユーザにファイル選択を迫る際に、フィルターをかける必要がある。

クラスモジュールのコード

まず、クラスモジュールを挿入し、「オブジェクト名」を「FileNameGetter」にした。

フィールド部分
Option Explicit
'フィールド
Private gotName_ As String         '……(1)
Private isFailed_ As Boolean       '……(2)
Private isCancelled_ As Boolean    '……(3)

まずは、フィールド部分。

  • (1)は、取得したファイル名(フルパス)を入れておく変数。
  • (2)は、処理が失敗したかどうかを保持する変数。処理が失敗したらTrueが入る。
  • (3)は、キャンセルされたかどうかを保持する変数。ファイル選択がキャンセルされたらTrueが入る。
アクセサ部分
'アクセサ
Public Property Get gotName() As String
  gotName = gotName_
End Property
Public Property Get isFailed() As String
  isFailed = isFailed_
End Property
Public Property Get isCancelled() As String
  isCancelled = isCancelled_
End Property

特記事項なし。いづれも読み取り専用にしている。

コンストラクタ部分
'コンストラクタ
Private Sub Class_Initialize()
  gotName_ = ""
  isFailed_ = False
  isCancelled_ = False
End Sub

一応、初期化しているけど、全部デフォルト値を代入しているだけなので、別になくても良いと思う。

メソッド部分
'メソッド
Public Sub getFileName(ByVal prompt As String, _
                       ByVal appName As String, _
                       ByVal baseStr As String)             '……(1)
  '引数「baseStr」に3文字以外の文字列を指定すると、実行時エラーを返す。
  If Len(baseStr) <> 3 Then                                 '……(2)
    Err.Raise 10000, Description:="拡張子は必ず最初の3文字を指定せよ。" & vbCrLf & _
                                  "getFileNameメソッドの第3引数を訂正せよ。"
  End If
  isCancelled_ = False
  isFailed_ = False
  Dim str As Variant                                        '……(3)
  Dim baseName As String
  str = Application.GetOpenFilename(Title:=prompt, _
                                    FileFilter:=appName & "," & "*." & baseStr & "?") '……(4)
  If str = False Or str = "" Then                           '……(5)
    MsgBox "キャンセルされました。", vbInformation
    isCancelled_ = True
    Exit Sub
  End If
  baseName = Right(str, Len(str) - InStrRev(str, "."))      '……(6)
  If Left(baseName, 3) = baseStr Then
    gotName_ = str
  Else
    isFailed_ = True
    MsgBox "ファイルの指定が間違えています。" & vbCrLf & _
           appName & "ファイルを選択せよ。", vbCritical
  End If
End Sub

このクラスの唯一のメソッド。

3つの引数を渡して実行するようにしている。すなわち、

  • 第1引数「prompt」は、ファイル選択ダイアログのタイトル
  • 第2引数「appName」は、FileFilterで表示するアプリケーション名
  • 第3引数「baseStr」は、FileFilterで表示する拡張子
  • の3つ。

ちなみに、「FileFilter」ってのは、

f:id:akashi_keirin:20170318214721j:plain

この赤枠囲みのところね。

コード内の(1)については説明したから、(2)以降について説明。

  • (2)で、渡された引数のチェック。第3引数に必ず3文字の引数が渡されるようにしている。これは、このクラスを使用するプログラマに知らせる必要のあることなので、自作のエラーを表示させている。
  • (3)で変数「str」を準備。GetOpenFilenameメソッドの戻り値を格納するための変数なんだが、ユーザがファイル選択ダイアログで「キャンセル」を選択すると、Booleanの「False」が返るので、StringでもBooleanでも格納できるVariantにしている。
  • (4)がGetOpenFilenameメソッド。引数FileFilterを指定することにより、ダイアログに必要なファイルだけを表示させることができる。引数FileFilterの内容をよく見たら、上の画像の赤枠囲み部分と同じであることが分かるだろう。
  • (5)の条件指定だが、一つ目の「False」は、ユーザがファイル選択ダイアログで「キャンセル」を選んだ場合、二つ目は、何もファイルを選択せずに「OK」をクリックした場合。つまり、ファイルが選択されなかった場合、ということ。

ところで、上記コード中の(6)だが、たぶん必要ないと思う。

一応、説明しておくと、

Right関数とLen関数、InStrRev関数を組み合わせて、取得したファイル名から拡張子の部分を取り出し、引数で受け取った拡張子と比較。拡張子が違っていたら、isFailedプロパティにTrueをセットし、メッセージを表示

ということなのだが、そもそもGetOpenFilenameメソッドでファイルフィルターをかけているのだから、拡張子が食い違うことなどないと思う。なんでこんなコード書いたんだろ……?

追記

>そもそもGetOpenFilenameメソッドでファイルフィルターをかけているのだから、拡張子が食い違うことなどない
……と思っていたけど、「ファイル名」のところに表示されていないけど存在するファイル名をジカ打ちしたら拡張子が食い違うことがあり得る。すげえな、このコード書いた当時の私……w そんなことまで想定していたのか……!

FileNameGetterを使用する

標準モジュールのコード

まずは、宣言セクションで、

Public fng As FileNameGetter

Public変数としてインスタンス用の変数を宣言しておく。

Sub getStampFile()
  Set fng = New FileNameGetter          '……(1)
  With fng                              '……(2)
    .getFileName "ハンコ用のpngファイルを選べ。", "png", "png"  '……(3)
    If .isCancelled = False And .isFailed = False Then          '……(4)
      Range("ImageFilePath").Value = .gotName
    End If
  End With
  Set fng = Nothing
End Sub

コードの説明

  • (1)は、おなじみFileNameGetterクラスのインスタンス化。
  • この先、FileNameGetterクラスのインスタンス「fng」に対する操作が多くなるので、(2)のようにWithでまとめてしまう。インスタンス化した後、Withでまとめるのはよく使う手法だと思う。
  • (3)でgetFileNameメソッドを使用。引数の渡し方に注目。こんなふうに使う。
  • (4)。getFileNameメソッドを経て、isCancelledプロパティか、isFailedプロパティがTrueになっていたとしたら、ファイル名の取得に失敗しているということ。つまり、両方Falseだったら、無事にファイル名が取得できているということだ。

シートモジュールのコード

Wordファイルのフルパスを取得する処理は、セルのダブルクリックイベントをきっかけに発動するようにした。従って、シートモジュールにイベントマクロとして書いている。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Row = 2 And Target.Column = 1 Then    '……(1)
    Set fng = New FileNameGetter
    With fng
      .getFileName "写しを作成するWordファイルを指定するがよい。", _
                   "Word", "doc"                   '……(2)
      If .isCancelled = True Or .isFailed = True Then                 '……(3)
        Cancel = True
      Else
        Target.Value = .gotName
        Cancel = True
      End If
    End With
  Else
    Cancel = True
  End If
Set fng = Nothing
End Sub

コードの説明

  • (1)は、イベントマクロを起動させる条件の設定。A2セルをダブルクリックしたときだけで良いからこうなる。

ちなみに、A2セルに「DocumentPath」と名前をつけているにもかかわらず、(1)を

If Target.Name = "DocumentPath" Then

としてもうまくいかない。なんでだろ???

  • (2)は、getFileNameメソッドの呼び出し。Wordファイルの場合だと、こんな指定の仕方になる。
  • (3)。getFileNameメソッドの実行後、isCancelledプロパティか、isFailedプロパティのいづれかがTrueになっているということは、ファイル名が取得できていないということだから、何もせずにダブルクリックイベントをキャンセルする。逆に、いづれもFalseだったら、ファイル名が取得できているということだから、取得したファイル名をA2セルに書き込む。

おわりに

ファイル名を取得する、というのはよくやる処理だと思うが、クラスとして設定しておくことで、非常に使いやすくなる。クラスって、状態と振る舞いを兼ね備えているので、「FileNameGetterさん、ファイル名を取ってきて~」と、あたかも人に頼むかのようにコードを書くことができるのが強みだと思う。

今回紹介した「FileNameGetter」クラスは、そのまま他のマクロでも使えると思う。

よく使う機能をクラス単位で蓄積していったら、マクロ作りがメチャクチャはかどるようになると思う。