写しPDF作成マクロ~(1)
書類が「写し」であることを示すために、「写」ハンコを押して送ったり、職場内で回覧したり、ということがある。
まあ、職場内で回覧する分にはハンコを押すだけの話なので何ということはないのだが、「写し」であることを明示した上でメールで送る、ということになると、Wordで作った書類なのに、
- 一旦プリントアウトする
- ハンコを押す
- スキャンしてPDFにする
という実にマヌケなことをやる羽目になる。
……とまあ、そんなわけで無駄に
Wordファイルから「写しPDF」を作成するマクロ
を作ってみた。
仕様
- Wordファイルと写しハンコ用画像ファイル(透過png)からPDFファイルを生成する
- Wordファイルの指定は、セルのダブルクリックでファイル選択ダイアログを呼び出すことで行う
- ハンコ用画像ファイルの指定は、シート上のボタンクリックでファイル選択ダイアログを呼び出すことで行う
- 両方のファイル名(フルパス)が指定されていたら、シート上のボタンクリックでマクロを実行する
- Wordファイルが複数ページある場合は、各ページの上中央に「写」ハンコ画像をセットする
- PDFファイルとして出力し、「写しPDF」というフォルダに保存する
- 本体のExcelファイルがあるフォルダに「写しPDF」フォルダがなかったら自動で作成する
まあ、こんな感じ。
操作イメージ
画面構成はこんなの。
赤枠のセルをダブルクリックすると、
ファイル選択ダイアログが出てくるので、元になるWordファイルを選択する。
セルにファイルのフルパスが書き込まれた。
このボタンをクリックすると、
ファイル選択ダイアログが表示されるので、ハンコ用のpngファイルを選択する。
セルにファイルのフルパスが書き込まれている。
ちなみに、ハンコ用の画像ファイルは、
こんなの。私はスキルがないので、Wordで作ってIrfanViewで透過pngにした。
ここまで準備ができたら、このボタンをポチッ!
あっという間にできあがり。
「写しPDF」フォルダ内にはPDFファイルが保存されている。
仕上がりは、こんな感じ。ちゃんと透けているところがリアルでしょう?w
ちなみに、元のWordファイルは、
こんな感じです。
ソースコード等については、追々書いていきます。
私がクラスモジュールを使い始めたきっかけ
きっかけ
そもそもは、自分に降りかかる火の粉を、少しでも楽に振り落としたいからだった。
thom(id:t-hom)さんが、コチラで言及してくださったが、私はあくまでも素人に過ぎないのに、職場では
それって、プログラマの仕事じゃね?
的なことをさせられてしまっている。通常業務は通常業務として他の職員と変わらず割り当てられているにもかかわらず。
今の上司にVBAのスキルがバレるまでは、まあ、自分の仕事を少しでも楽にできるように、と好き勝手にコードを書き散らしていた。
必要な機能さえとにかく盛ればいいんだから、チャチャッと書いてサクッと使う。次に同じようなことをするときには、そのコードの意味なんか忘れているけど、読み直したらまあ分かるからチョコチョコッと直しては使い……という感じだった。
しかし、今の上司と出会ってしまってからは、ひつこいようだが、
完全に他人が使うためのマクロ
を作らされることが多くなった。
このときにも書いたけど、
「マクロ? それ何ていう寿司ネタ?」
みたいな人が使うのを想定したマクロって、本当に大変。
しかも、上司の指示がテキトーで、いっつも
こんな風にできたらええなーと思うんや
みたいな雑な指示で作成を命じ、できあがって納品(?)したらしたで、ろくにテストもしてくれずに他の部署に提供し、だいぶ経ってから
あ、こことここをチョイチョイッと直しといて
とか、
この機能やけど、ここがこんなふうになった方が便利やと思うんや
と、一事が万事この調子。
後出しジャンケン祭り状態。
こうなると、そもそもマクロを作るときに思いつきでいわゆる「スパゲティ・コード」なんか書いてしまった日には、私の命がいくつあっても足りない状態になるわけ。
それまで、「設計」なんて概念とは無縁で、
コメントしっかり書いときゃ大丈夫っしょ?
ぐらいに思っていたけど、そんなことを言ってられなくなったのだ。
クラスモジュールとの出会い
たまたま、意味も分からず「オブジェクト指向」に憧れていたこともあって、
オブジェクト指向というのはプログラムの変更・追加に強いプログラミング・テクニックらしい
というようなことが記憶の片隅にあったので、本格的にJavaの勉強を始めたのが「クラス」という概念との出会いだった。
そして、thom(id:t-hom)さんのブログとか、コチラのおかげで、VBAでもオブジェクト指向っぽいことができることが分かり、導入しはじめたというわけ。
まだまだクラスモジュールを十分に使いこなせているとは言えないけど、ついこないだ、機能変更の問い合わせを受けたときには、ものの1分ほどで対応ができた。そのマクロは、クラスモジュールを活用して作ったもので、問い合わせのあった機能の部分がうまくカプセル化できていたことからすると、少しづつ上達はしてきているのだと思う。
おわりに
thom(id:t-hom)さんがおっしゃってくださったように、スキルを身につけた人というのは、スキルを持っていない人が他のことに費やしていたお金とか時間をそのスキルの習得に費やしているのである。
しかも、見落とされがちなことかも知れないが、
スキルを維持するのにもお金と時間がかかる
のである。
それを、まるで背が高い人に高いところにある荷物を取ってもらうような調子で
チャチャッと作っといて
と気安く頼んでくる人の気が知れない。
年度が変わったらきっぱりと言ってやろう。
Thunderbirdメール自動作成マクロを改良した
準備
セルに名前をつける。
こんな具合に「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」と名付けたセルに書き込む。
セルに独自の名前を付けておくと、いちいちブックやシートの指定をせずに済むから楽。
実行
マクロをシート上のボタンに登録して、
ボタンをポチッ!
Thunderbirdのショートカットを選択して[OK]。
結果
ほれ、この通り、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)
としてやれば良い。
これでより一層便利になった。
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」を渡して呼び出し。
果たして、実行結果は……???
実行結果
実行以前にコンパイルエラーwww
結論
え? 当たり前、ですか?
そら知らなんだw サーセンwww
Select / Activateメソッドの極小ハマり
状況
ワークシート
こんな風にシートを準備して、
それぞれのシートはこんな風にカレンダーにした。
クラスモジュールのコード
「オブジェクト名」は「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
実行結果
ここまではうまいこと行くのだが……。
こんなエラーが出てしまう。
エラーの原因
エラーメッセージから、DaySelectorクラスのwriteStartTimeメソッドに問題があることはすぐに分かったが、処理があまりにも単純なので、かなりの時間、何が悪いのか分からなかった。
結局、シートがアクティブでないのに、そのシートのセルを選択/アクティベートしようとしたためにエラーになった、というだけのことだった。
コードの修正
startCell_.Select
を、
startCell_.Parent.Activate
startCell_.Select
にするだけ。たったこれだけ。
やっぱり、「Parent」プロパティは便利だ。
それはともかく、結構初歩的なところでハマることもある、というお話でした。
Wordから転記した表で小ハマリ……
前にコチラで紹介した、
Wordの表からExcelの表にデータを転記するマクロ
なんですが、またしても軽くハマったので、覚書も兼ねて上げておく。
第1段階
Wordのこんな表から、
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
実行結果
こんな風に転記された。
第2段階
転記してできた表に対して、次のような処理を行うことにした。
- 「吉岡タイトル」列(F列)を選択してマクロ実行
- 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」とか、アホ丸出しだが、許せしてください。
問題
唐突だが、ここで問題。
画像のように、F2セルを選択した状態で上記の「checkTitleOfYoshioka」を実行するとどうなると思いますか?
もちろん、私はF2セルに「○」が入ると思っていましたよ。だって、そうするつもりでコードを書いたんですから。
実行結果
エッーーーーーーー!!
「吉岡タイトル」欄に「○」がつくはずなのに、空欄のまま……。
わけがわからないのでステップ実行してみる。
変数「i」が「3」なので、「.Cells(objCell.Row, i)」すなわちC2セルの値は「吉岡 稔真」のはず。ということは、次の行に処理が移るはず。[F8]をポチッ!
は、はぁ~~~ん???
なんで「End If」のところへ行くのさ???
イミディエイト・ウインドウで確かめても「Range("C2").Value」は「吉岡 稔真」……。
だのに、どうしてこんなことになるのでしょうか!?
答えが分かったらコメント欄にどうぞ!
ヒント
イミディエイト・ウインドウに「?Range("C2").Value」と打ち込んで、[Enter]を押した直後の画像がこれ。勘のいい人ならこれで分かりますよね!
勘の悪い私は、気づくのに異様に時間がかかったんですけど……。
挑戦者求む!
ファイルのフルパスを簡単に取得する
はじめに
メール自動作成マクロ(その1/その2/その3/その4)では、添付ファイルをセットするために表の中に添付ファイルのフルパスを入力しておく必要があった。
しかし、「添付ファイルのフルパスの入力なんてめんどくせーよな!」と誰しも思う。だから、簡単に入力できる方法が必要だ。
そこで、今回は、
セルをダブルクリックしたらファイル選択ダイアログが出てきて、そこで選んだファイルのフルパスがセルに入力される
という方針でやってみよう。
今回も、おなじみのこの表を使う。この表のU列~AD列のセルにファイルのフルパスを書き込むためのマクロ、ということ。
「セルをダブルクリックしたら」なので、Worksheetオブジェクトのイベントプロシージャ・「Worksheet_BeforeDoubleClick」を使う。
コードの作成
イベントプロシージャを書くときは、プロジェクトエクスプローラで、対象のオブジェクト名をダブルクリックしたらいい。今回は、「Sheet1」のところをダブルクリック。
「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
おわりに
ここまで来ると、かなり便利なツールになってきます。