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

書類が「写し」であることを示すために、「写」ハンコを押して送ったり、職場内で回覧したり、ということがある。

まあ、職場内で回覧する分にはハンコを押すだけの話なので何ということはないのだが、「写し」であることを明示した上でメールで送る、ということになると、Wordで作った書類なのに、

  • 一旦プリントアウトする
  • ハンコを押す
  • スキャンしてPDFにする


という実にマヌケなことをやる羽目になる。

……とまあ、そんなわけで無駄に

Wordファイルから「写しPDF」を作成するマクロ

を作ってみた。

仕様

  • Wordファイルと写しハンコ用画像ファイル(透過png)からPDFファイルを生成する
  • Wordファイルの指定は、セルのダブルクリックでファイル選択ダイアログを呼び出すことで行う
  • ハンコ用画像ファイルの指定は、シート上のボタンクリックでファイル選択ダイアログを呼び出すことで行う
  • 両方のファイル名(フルパス)が指定されていたら、シート上のボタンクリックでマクロを実行する
  • Wordファイルが複数ページある場合は、各ページの上中央に「写」ハンコ画像をセットする
  • PDFファイルとして出力し、「写しPDF」というフォルダに保存する
  • 本体のExcelファイルがあるフォルダに「写しPDF」フォルダがなかったら自動で作成する

まあ、こんな感じ。

操作イメージ

f:id:akashi_keirin:20170318173834j:plain

画面構成はこんなの。

赤枠のセルをダブルクリックすると、

f:id:akashi_keirin:20170318173845j:plain

ファイル選択ダイアログが出てくるので、元になるWordファイルを選択する。

f:id:akashi_keirin:20170318173855j:plain

セルにファイルのフルパスが書き込まれた。

f:id:akashi_keirin:20170318173933j:plain

このボタンをクリックすると、

f:id:akashi_keirin:20170318173953j:plain

ファイル選択ダイアログが表示されるので、ハンコ用のpngファイルを選択する。

f:id:akashi_keirin:20170318174003j:plain

セルにファイルのフルパスが書き込まれている。

ちなみに、ハンコ用の画像ファイルは、

f:id:akashi_keirin:20170318174024j:plain

こんなの。私はスキルがないので、Wordで作ってIrfanViewで透過pngにした。

f:id:akashi_keirin:20170318174116j:plain

ここまで準備ができたら、このボタンをポチッ!

f:id:akashi_keirin:20170318174124j:plain

あっという間にできあがり。

f:id:akashi_keirin:20170318174136j:plain

「写しPDF」フォルダ内にはPDFファイルが保存されている。

f:id:akashi_keirin:20170318174144j:plain

仕上がりは、こんな感じ。ちゃんと透けているところがリアルでしょう?w

ちなみに、元のWordファイルは、

f:id:akashi_keirin:20170318174152j:plain

こんな感じです。

ソースコード等については、追々書いていきます。

私がクラスモジュールを使い始めたきっかけ

きっかけ

そもそもは、自分に降りかかる火の粉を、少しでも楽に振り落としたいからだった。

thom(id:t-hom)さんが、コチラで言及してくださったが、私はあくまでも素人に過ぎないのに、職場では

それって、プログラマの仕事じゃね?

的なことをさせられてしまっている。通常業務は通常業務として他の職員と変わらず割り当てられているにもかかわらず。

今の上司にVBAのスキルがバレるまでは、まあ、自分の仕事を少しでも楽にできるように、と好き勝手にコードを書き散らしていた。

必要な機能さえとにかく盛ればいいんだから、チャチャッと書いてサクッと使う。次に同じようなことをするときには、そのコードの意味なんか忘れているけど、読み直したらまあ分かるからチョコチョコッと直しては使い……という感じだった。

しかし、今の上司と出会ってしまってからは、ひつこいようだが、

完全に他人が使うためのマクロ

を作らされることが多くなった。

このときにも書いたけど、

「マクロ? それ何ていう寿司ネタ?」

みたいな人が使うのを想定したマクロって、本当に大変。

しかも、上司の指示がテキトーで、いっつも

こんな風にできたらええなーと思うんや

みたいな雑な指示で作成を命じ、できあがって納品(?)したらしたで、ろくにテストもしてくれずに他の部署に提供し、だいぶ経ってから

あ、こことここをチョイチョイッと直しといて

とか、

この機能やけど、ここがこんなふうになった方が便利やと思うんや

と、一事が万事この調子。

後出しジャンケン祭り状態。

こうなると、そもそもマクロを作るときに思いつきでいわゆる「スパゲティ・コード」なんか書いてしまった日には、私の命がいくつあっても足りない状態になるわけ。

それまで、「設計」なんて概念とは無縁で、

コメントしっかり書いときゃ大丈夫っしょ?

ぐらいに思っていたけど、そんなことを言ってられなくなったのだ。

クラスモジュールとの出会い

たまたま、意味も分からず「オブジェクト指向」に憧れていたこともあって、

オブジェクト指向というのはプログラムの変更・追加に強いプログラミング・テクニックらしい

というようなことが記憶の片隅にあったので、本格的にJavaの勉強を始めたのが「クラス」という概念との出会いだった。

そして、thom(id:t-hom)さんのブログとか、コチラのおかげで、VBAでもオブジェクト指向っぽいことができることが分かり、導入しはじめたというわけ。

まだまだクラスモジュールを十分に使いこなせているとは言えないけど、ついこないだ、機能変更の問い合わせを受けたときには、ものの1分ほどで対応ができた。そのマクロは、クラスモジュールを活用して作ったもので、問い合わせのあった機能の部分がうまくカプセル化できていたことからすると、少しづつ上達はしてきているのだと思う。

おわりに

thom(id:t-hom)さんがおっしゃってくださったように、スキルを身につけた人というのは、スキルを持っていない人が他のことに費やしていたお金とか時間をそのスキルの習得に費やしているのである。

しかも、見落とされがちなことかも知れないが、

スキルを維持するのにもお金と時間がかかる

のである。

それを、まるで背が高い人に高いところにある荷物を取ってもらうような調子で

チャチャッと作っといて

と気安く頼んでくる人の気が知れない。

年度が変わったらきっぱりと言ってやろう。

Thunderbirdメール自動作成マクロを改良した

準備

セルに名前をつける。

f:id:akashi_keirin:20170318080804j:plain

こんな具合に「ThunderBirdPath」と名前をつけた。

標準モジュールのコード

Sub getThunderbirdPath()
  Set flp = New FilePicker                                  '……(1)
  With flp
  .showFilePicker ("Thunderbirdの実行ファイルを指定せよ(ショートカットでも良い)")  '……(2)
    If .isCancelled = False Then                            '……(3)
      Range("ThunderbirdPath").Value = .gotFileFullPath     '……(4)
    End If
  End With
End Sub

たったこんだけ。このときに作成した「FilePicker」クラスを使用。うん、メッチャ便利w 自作Functionでやっていた時期もあったけど、自作クラスの方が圧倒的に使い勝手がいい! アドヴァイスをくださったフォロワーさんに感謝!

どうでもいいけど、最近、EdgeでURLを選択して右クリックしたら、いきなりEdgeが落ちるんだけど、何なのこれ? 不便でしゃーないんやけど。

コードの説明

  • (1)でFilePickerクラスのインスタンスを生成。
  • (2)で、showFilePickerメソッドを呼び出す。引数で渡した文字列が、ウインドウのタイトルとして表示される。
    ※この引数はOptionalにした方が良いと思った。
  • (3)。ファイル選択をキャンセルしたら、isCancelledプロパティがTrueになるようにしているので、Falseだったら何らかのファイルフルパスがgotFileFullPathプロパティにセットされていることになる。
  • (4)でめでたく取得したファイルのフルパスを「ThunderbirdPath」と名付けたセルに書き込む。
    セルに独自の名前を付けておくと、いちいちブックやシートの指定をせずに済むから楽。

実行

マクロをシート上のボタンに登録して、

f:id:akashi_keirin:20170318081442j:plain

ボタンをポチッ!

f:id:akashi_keirin:20170318080810j:plain

Thunderbirdのショートカットを選択して[OK]。

結果

f:id:akashi_keirin:20170318080817j:plain

ほれ、この通り、Thunderbirdの実行ファイルのフルパスがセルにセットされた。

後は、このセルの値を引数として渡してThunderbirdメール作成メソッドを実行するようにしたら良い。

たとえば、このとき作成したメソッドだったら、まずメソッド名を

Public Sub createThunderbirdMail(ByVal tbp As String)

と、このように文字列を引数として受け取るようにしておいて、

Thunderbirdのフルパスを、

Dim thunderbirdPath As String
  thunderbirdPath = """" & THUNDERBIRD_PATH & """ -compose """

と、こんなふうに定数にしていたのを、

Dim thunderbirdPath As String
  thunderbirdPath = """" & tbp & """ -compose """

こんなふうに引数名に変えて、実行時に、

md.createThunderbirdMail (Range("ThunderbirdPath").Value)

としてやれば良い。

これでより一層便利になった。

@akashi_keirin on Twitter

VBAでは、メソッドのオーバーロードができなかった

やってみた。

準備

標準モジュールのコード

Private Sub makeUserSick()                       '……(1)
  MsgBox "     _________" & vbCrLf & _
         " /          \ " & vbCrLf & _
         "/ /・\  /・\    \" & vbCrLf & _
         "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
         "|    (_人_)    |" & vbCrLf & _
         "|     \     |          |" & vbCrLf & _
         "\      \_|     /"
End Sub

Private Sub makeUserSick(ByVal msg As String)               '……(2)
  MsgBox msg & vbCrLf & _
         "     _________" & vbCrLf & _
         " /          \ " & vbCrLf & _
         "/ /・\  /・\    \" & vbCrLf & _
         "|   ̄ ̄    ̄     | ち~んw" & vbCrLf & _
         "|    (_人_)    |" & vbCrLf & _
         "|     \     |          |" & vbCrLf & _
         "\      \_|     /"
End Sub

説明

  • (1)の「makeUserSick」プロシージャは、引数なし。
  • (2)の「makeUserSick」プロシージャは、引数「msg」がある。

同じプロシージャ名で、違うのは引数の構成だけなので、これができるんなら、メソッドのオーバーロードが可能、ということになる。

実行

では、実行してみよう。

実行用のコード

Sub test()
  Call makeUserSick                     '……(1)
  Call makeUserSick("アホwww")       '……(2)
End Sub

コードの説明

  • (1)は、引数なしで呼び出し。
  • (2)は、引数として文字列「アホwww」を渡して呼び出し。

果たして、実行結果は……???

実行結果

f:id:akashi_keirin:20170318072916j:plain

実行以前にコンパイルエラーwww

結論

VBAでは、メソッドのオーバーロードはできません。

え? 当たり前、ですか?

そら知らなんだw サーセンwww

@akashi_keirin on Twitter

Select / Activateメソッドの極小ハマり

状況

ワークシート

f:id:akashi_keirin:20170315232338j:plain

こんな風にシートを準備して、

f:id:akashi_keirin:20170315232345j:plain

それぞれのシートはこんな風にカレンダーにした。

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

「オブジェクト名」は「DaySelector」にしている。

Option Explicit
'フィールド
Private startCell_ As Range
Private endCell_ As Range
Private startTime_ As Date
Private endTime_ As Date
'アクセサ
Public Property Get startCell() As Range
  Set startCell = startCell_
End Property
Public Property Get endCell() As Range
  Set endCell = endCell_
End Property
Public Property Get startTime() As Date
  startTime = startTime_
End Property
Public Property Get endTime() As Date
  endTime = endTime_
End Property
'コンストラクタ
Private Sub Class_Initialize()
  Dim m As Integer
  Dim d As Integer
  m = Month(Now())
  d = Day(Now())
  Call setStartCell(m, d)
  Set endCell_ = startCell_.Offset(0, 1)
End Sub
Private Sub setStartCell(ByVal m As Integer, ByVal d As Integer)
  With ThisWorkbook
    If m > 3 And m < 13 Then
      With .Worksheets(m - 3)
        Set startCell_ = .Range("C" & d + 1)
      End With
    Else
      With .Worksheets(m + 9)
        Set startCell_ = .Range("C" & d + 1)
      End With
    End If
  End With
End Sub

'メソッド
Public Sub writeStartTime()
  If startCell_.Value = "" Then
    startCell_.Value = Format(Now(), "hh:mm")
    MsgBox "始業時刻を書き込みました。" & vbCrLf & _
           "修正する場合は、セルに時刻を直接入力してください。"
  End If
  startCell_.Select
End Sub
Public Sub writeEndTime()
  Dim res As Integer
  res = MsgBox(PROMPT:="終業時刻を書き込みますか?", Buttons:=vbYesNo)
  If res = vbYes Then
    endCell_.Value = Format(Now(), "hh:mm")
  End If
End Sub

標準モジュールのコード

Public ds As DaySelector

Workbookモジュールのコード

Option Explicit
Private Sub Workbook_Open()
  Set ds = New DaySelector
  ds.writeStartTime
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Set ds = New DaySelector
  ds.writeEndTime
End Sub

実行結果

f:id:akashi_keirin:20170315232350j:plain

f:id:akashi_keirin:20170315232359j:plain

ここまではうまいこと行くのだが……。

f:id:akashi_keirin:20170315232354j:plain

こんなエラーが出てしまう。

エラーの原因

エラーメッセージから、DaySelectorクラスのwriteStartTimeメソッドに問題があることはすぐに分かったが、処理があまりにも単純なので、かなりの時間、何が悪いのか分からなかった。

結局、シートがアクティブでないのに、そのシートのセルを選択/アクティベートしようとしたためにエラーになった、というだけのことだった。

コードの修正

startCell_.Select

を、

startCell_.Parent.Activate
startCell_.Select

にするだけ。たったこれだけ。

やっぱり、「Parent」プロパティは便利だ。

それはともかく、結構初歩的なところでハマることもある、というお話でした。

@akashi_keirin on Twitter

Wordから転記した表で小ハマリ……

前にコチラで紹介した、

Wordの表からExcelの表にデータを転記するマクロ

なんですが、またしても軽くハマったので、覚書も兼ねて上げておく。

第1段階

f:id:akashi_keirin:20170313230205j:plain

Wordのこんな表から、

f:id:akashi_keirin:20170313230211j:plain

Excelのこんな表にデータをマクロで転記した。

使用したコード

Option Explicit
Sub transferFromWordTable()
On Error GoTo myError
  Err.Clear
  Dim tgtRow As Integer
  tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row + 1
  Dim n As Integer
  n = tgtRow  '書き込み開始行を保持しておく
  '参照設定でWordのオブジェクトライブラリにチェックを入れている。
  Dim objWord As Word.Application
  Dim objDoc As Document
  Dim objFileName As String
  Dim objFolderName As String
  Set objWord = GetObject(, "Word.Application")
  Set objDoc = objWord.ActiveDocument
  objFileName = objDoc.Name
  objFolderName = ThisWorkbook.Path & "\★hogehoge\"
  With ThisWorkbook.Worksheets("Main")
    .Range("A" & tgtRow).Value = objWord.Selection.Text
    Dim i As Integer
    For i = 2 To 9
      .Range("B" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 1).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 1).Range.Text) - 1)
      .Range("C" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 2).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 2).Range.Text) - 1)
      .Range("D" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 3).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 3).Range.Text) - 1)
      .Range("E" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 4).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 4).Range.Text) - 1)
    Next
    tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row
    For i = n To tgtRow
      If .Range("B" & i).Value = vbCr Then
        .Range("B" & i).Value = ""
      End If
    Next
  End With
  objDoc.Close False
  If objWord.Documents.Count = 0 Then
    objWord.Quit
  End If
  Set objWord = Nothing
  Set objDoc = Nothing
  Name objFolderName & objFileName As _
       objFolderName & "転記済み\" & objFileName
  Exit Sub
myError:
  Debug.Print Err.Number & ":" & Err.Description
  Word.Application.Quit
End Sub

実行結果

f:id:akashi_keirin:20170313230218j:plain

こんな風に転記された。

第2段階

転記してできた表に対して、次のような処理を行うことにした。

  1. 「吉岡タイトル」列(F列)を選択してマクロ実行
  2. C列~E列を順に調べ、一つでも「吉岡 稔真」と書かれたセルがあったらF列に「○」をつける。

まあ、実にしょうもないマクロだが、こんなことをしたと思ってほしい。

使用したコード

Sub checkTitleOfYoshioka()
  Dim objCell As Range
  Set objCell = ActiveCell
  Dim i As Integer
  With ThisWorkbook.Worksheets("Main")
    For i = 3 To 5
      If .Cells(objCell.Row, i).Value = "吉岡 稔真" Then
        .Cells(objCell.Row, 6).Value = "○"
        Exit For
      End If
    Next
  End With
End Sub

プロシージャ名が「checkTitleOfYoshioka」とか、アホ丸出しだが、許してください。

問題

唐突だが、ここで問題。

f:id:akashi_keirin:20170313230224j:plain

画像のように、F2セルを選択した状態で上記の「checkTitleOfYoshioka」を実行するとどうなると思いますか?

もちろん、私はF2セルに「○」が入ると思っていましたよ。だって、そうするつもりでコードを書いたんですから。

実行結果

f:id:akashi_keirin:20170313230242j:plain

エッーーーーーーー!!

「吉岡タイトル」欄に「○」がつくはずなのに、空欄のまま……。

わけがわからないのでステップ実行してみる。

f:id:akashi_keirin:20170313230251j:plain

変数「i」が「3」なので、「.Cells(objCell.Row, i)」すなわちC2セルの値は「吉岡 稔真」のはず。ということは、次の行に処理が移るはず。[F8]をポチッ!

f:id:akashi_keirin:20170313230301j:plain

は、はぁ~~~ん???

なんで「End If」のところへ行くのさ???

f:id:akashi_keirin:20170313230349j:plain

イミディエイト・ウインドウで確かめても「Range("C2").Value」は「吉岡 稔真」……。

だのに、どうしてこんなことになるのでしょうか!?

答えが分かったらコメント欄にどうぞ!

ヒント

f:id:akashi_keirin:20170313230401j:plain

イミディエイト・ウインドウに「?Range("C2").Value」と打ち込んで、[Enter]を押した直後の画像がこれ。勘のいい人ならこれで分かりますよね!

勘の悪い私は、気づくのに異様に時間がかかったんですけど……。

挑戦者求む!

@akashi_keirin on Twitter

ファイルのフルパスを簡単に取得する

はじめに

メール自動作成マクロ(その1その2その3その4)では、添付ファイルをセットするために表の中に添付ファイルのフルパスを入力しておく必要があった。

しかし、「添付ファイルのフルパスの入力なんてめんどくせーよな!」と誰しも思う。だから、簡単に入力できる方法が必要だ。

そこで、今回は、

セルをダブルクリックしたらファイル選択ダイアログが出てきて、そこで選んだファイルのフルパスがセルに入力される

という方針でやってみよう。

f:id:akashi_keirin:20170311114734j:plain

f:id:akashi_keirin:20170311114741j:plain

f:id:akashi_keirin:20170311114749j:plain

今回も、おなじみのこの表を使う。この表のU列~AD列のセルにファイルのフルパスを書き込むためのマクロ、ということ。

「セルをダブルクリックしたら」なので、Worksheetオブジェクトのイベントプロシージャ・「Worksheet_BeforeDoubleClick」を使う。

コードの作成

f:id:akashi_keirin:20170312205644j:plain

イベントプロシージャを書くときは、プロジェクトエクスプローラで、対象のオブジェクト名をダブルクリックしたらいい。今回は、「Sheet1」のところをダブルクリック。

f:id:akashi_keirin:20170312205647j:plain

「Sheet1」モジュールのコードウインドウが表示されるので、上の2つの窓でそれぞれ「Worksheet」(左)と「BeforeDoubleClick」を選択すると、

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

End Sub

ってのが自動的に生成されるので、真ん中のところにコードを書いていきゃいい。

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

Option Explicit

Const PROMPT As String = "添付するファイルを指定してください。"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
  Err.Clear
  Application.EnableEvents = False                                        '……(1)
  Set flp = New FilePicker                                                '……(2)
  With Target
    If .Column < colNum.att01 Or .Column > colNum.att10 Or .Row = 1 Then  '……(3)
      Application.EnableEvents = True                                     '……(4)
      Exit Sub
    Else                                                                  '……(5)
      '添付ファイルが歯抜け状態で入力されないようにするための措置
      If .Column > colNum.att01 And .Offset(0, -1).Value = "" Then
        MsgBox "添付ファイルは左詰めになるように設定せよ。" & vbCrLf & "やり直すがよい。"
        Cancel = True                                                     '……(6)
        Application.EnableEvents = True
        Exit Sub
      End If
      flp.showFilePicker PROMPT                                           '……(7)
      If flp.isCancelled = True Then                                      '……(8)
        Cancel = True
        Application.EnableEvents = True
        Exit Sub
      End If
      If LenB(flp.gotFileFullPath) > 220 Then                             '……(9)
        MsgBox "添付ファイルのフルパスのサイズが220バイトを超えています。" & vbCrLf & _
        "添付ファイルをデスクトップに貼り付けるなど、フルパスを短くしてください。"
        Cancel = True
        Application.EnableEvents = True
        Exit Sub
      Else
        .Value = flp.gotFileFullPath                                      '……(10)
        Cancel = True
      End If
    End If
  End With
  Application.EnableEvents = True                                         '……(11)                                    
  If Err.Number > 0 Then
    If Err.Number = 1004 Then
      MsgBox "指定したファイル名(フルパス)が長すぎます。" & vbCrLf & _
             "フルパスが短くなるようにして、やり直してください。" & vbCrLf & _
             "【例】添付ファイルをデスクトップに貼り付けるなど"
    End If
    Call errorCatch("WorkSheets(""Main"")のWorksheet_BeforeDoubleClickプロシージャ", Err.Number, Err.Description)
  End If
  Application.EnableEvents = True
End Sub

コードの説明

このブログでイベントマクロを紹介するのは初めてだと思うので、自分の復習も兼ねてちょっとこってり書いておこう。

  • (1)で一旦イベントの発生を抑える。実は、今回のこのマクロだけだったらこれは必要ないんだけど、このシートではもう一つ「Worksheet_Change」というイベントマクロも書いているので、イベントの連鎖を防ぐためにこうしている。いきなり分かりにくくてすまん。
  • (2)では自作クラスFilePickerをインスタンス化。FilePickerのコードはコチラをどうぞ。
  • (3)では、ダブルクリックされた場所を判定。添付ファイル入力欄以外なら(4)に進む。
    ちなみに、列番号の指定はおなじみ列挙体を使用しています。(コチラを参考にどうぞ。)
  • (4)に処理が移るということは、添付ファイル入力欄ではないということだから、イベントの発生抑止を解除して処理を終了する。処理を終了するときに「Application.EnableEvents」をTrueにしておかないと、いろいろおかしなことになるから注意。
    ※ダブルクリックしたのに何も起こらない、とか。
  • (5)に処理が移ってくるということは、添付ファイル入力欄上でダブルクリックされた、ということ。
  • ただし、ダブルクリックされたセルが添付ファイル2~10までのセルなのに、左隣のセルが空白だったら、歯抜け状態になっているとみなしてメッセージを表示して終了する。
  • (6)の「Cancel = True」というのは「ダブルクリック」というイベントをキャンセルする、ということ。ふつうセルでダブルクリックしたら、編集モードに移るんだけど、それをキャンセルするので何も起こらない。要するに直接入力もさせない、ということだ。
  • ここまでの条件をクリアしてきたら、それは、「ダブルクリックされたセルが添付ファイルのフルパスを入力しても良いセル」ということになる。そこで、(7)、FilePickerクラスのshowFilePickerメソッドの出番だ。ファイル選択ダイアログのタイトル欄に表示する文字列を引数として渡して実行する。
  • (8)。ファイル選択ダイアログで[キャンセル]が選ばれたりしてファイルパスが取得できていなければ、isCancelledプロパティがTrueになっているので、処理を終了する。
  • (9)は、取得したファイルフルパスのバイト数でふるいにかけている。添付ファイルのフルパスが長いと添付できないことがあるから。ここではそのバイト数を220にしているけど、これは目分量みたいなもん。正確なところが分からないので、知っている人がいたら教えてください。
  • ここまで、数々の苦難を乗り越えて(10)まで来たら、やっとここで取得したファイルのフルパスをダブルクリックしたセルに書き込んでいる。
  • 最後に(11)のようにイベント発生を復活させておくのを忘れないように。

イベントマクロって、便利なんですけど、思いもかけないタイミングで発動することがあるので、慣れないうちは試行錯誤が必要ですね。ダブルクリックイベントなんかの場合、単独ではイベントの無限連鎖にはならないんだけど、他のイベントマクロとの合わせ技で無限連鎖が起こってしまうことがあるのでやっかいです。

【参考】クラスモジュールFilePickerのコード

Option Explicit

'フィールド
Private gotFileFullPath_ As String
Private isCancelled_ As Boolean
'アクセサ
Public Property Get gotFileFullPath() As String
  gotFileFullPath = gotFileFullPath_
End Property
Public Property Get gotFileName() As String
  gotFileName = Right(gotFileFullPath_, _
                     (Len(gotFileFullPath) - InStrRev(gotFileFullPath, "\")))
End Property
Public Property Get isCancelled() As Boolean
  isCancelled = isCancelled_
End Property
'コンストラクタ
Private Sub Class_Initialize()
  isCancelled_ = False
End Sub
'メソッド
Public Sub showFilePicker(ByVal titleStr As String)
  Dim fileFullPath As Variant
  fileFullPath = Application.GetOpenFilename(Title:=titleStr)
  If fileFullPath = False Then
    isCancelled_ = True
    gotFileFullPath_ = ""
  Else
    isCancelled_ = False
    gotFileFullPath_ = fileFullPath
  End If
End Sub

【参考】標準モジュールのコード

'列挙体(列名を表すのに使用)
Public Enum colNum
  isSent = 1
  numOf
  sendTo
  mailTo
  CC
  BCC
  mailSubj
  belongsTo
  jobTitle
  personName
  p01
  p02
  p03
  p04
  p05
  p06
  p07
  p08
  p09
  p10
  att01
  att02
  att03
  att04
  att05
  att06
  att07
  att08
  att09
  att10
  returnReceipt
End Enum
'クラス変数
Public flp As FilePicker

おわりに

ここまで来ると、かなり便利なツールになってきます。