Word 差込印刷のレコードごとにファイルを生成するマクロ
Wordの差込印刷でレコードごとにファイルを保存
普段、仕事で差込印刷をよく使うんだが、「レコードごとに別々のファイルにしてくんねーかなー」と思っていた。
以前は、
- 一旦、PDFにする
- １ページづつバラす
- それぞれにファイル名をつける
というおっそろしくメンドクサイことをしていたが（まあ、他の人が１個づつファイルを作っているのに比べたらそれでもだいぶ効率的なんですけど）、ggりまくって次のページにたどり着いた。
参考サイト１
「みんなのワードマクロ」様。
コチラのサンプルコードは、差込印刷のレコードごとに新しいドキュメントを生成していく、というもの。
これだよ、これ！ まさにこういうのが欲しかったんだよ！
という言葉しかございません。
差込印刷がMailMergeオブジェクトを使うんだなんて、いったいどうやってたどり着いたんだろ？
ただただすげえな、と思うばかり。
参考サイト２
VBA界では超有名な「インストラクターのネタ帳」様。
コチラのページからは、アクティブなページを削除するというワザを拝借しました。
標準モジュールのコード
ほとんど丸ごといただいたみたいなコードですが、めちゃ便利なので載っけときます。
Const FOLDER_NAME As String = "★作成した文書" 'フォルダ名を変えたらここを変えること。'
Sub insertionPrintAndCreateNewDoc()
If Dir(ThisDocument.Path & "\" & FOLDER_NAME, vbDirectory) = "" Then '……(1)'
Call MkDir(ThisDocument.Path & "\" & FOLDER_NAME)
Call MsgBox("作成済みファイルを保存するフォルダ「" & FOLDER_NAME & _
"」を、このファイルのあるディレクトリに作成しました。", vbInformation)
End If
Dim folderPath As String
folderPath = ThisDocument.Path & "\" & FOLDER_NAME & "\"
Dim baseDoc As Document '……(2)'
Dim newDoc As Document '……(3)'
Set baseDoc = ThisDocument '……(4)'
On Error GoTo HandleError
With baseDoc.MailMerge
Dim maxRec As Integer
maxRec = .DataSource.RecordCount '……(5)'
.Destination = wdSendToNewDocument '……(6)'
.SuppressBlankLines = True
Dim i As Integer
For i = 1 To maxRec '……(7)'
With .DataSource
.ActiveRecord = i '……(8)'
.FirstRecord = i
.LastRecord = i
End With
Call .Execute(Pause:=True)
DoEvents '……(9)'
Set newDoc = ActiveDocument
Dim tgtFileName As String
tgtFileName = .DataSource.DataFields("卒業期").Value & "期 " & _
.DataSource.DataFields("選手名").Value '……(10)'
If tgtFileName <> "" Then
Call newDoc.Bookmarks("\Page").Range.Delete '……(11)'
Call newDoc.SaveAs( _
fileName:=folderPath & tgtFileName & ".docx", _
fileformat:=wdFormatXMLDocument, _
addtorecentfiles:=False) '……(12)'
Call newDoc.Close
End If
DoEvents
Next
End With
Set baseDoc = Nothing
Set newDoc = Nothing
Exit Sub
HandleError:
Call MsgBox("エラーが発生しました。差込設定を見直すなど、設定を再確認してください。", vbExclamation)
End Sub
コードの説明
- (1)は、よくやるやつ。新しくできるファイルを保存するフォルダの有無を調べて、なかったら作る。
- (2)は、元のWordドキュメントを格納する変数。
- (3)は、新しくできるドキュメントを格納する変数。
- (4)で、マクロを書いているこのドキュメントを変数baseDocに格納。
- (5)で、変数maxRecにレコード数を格納。MailMerge.DataSourceオブジェクトのRecordCountプロパティから取得できる。
- (6)で、MailMergeオブジェクトのDestinationプロパティに定数wdSendToNewDocumentをセットしている。この定数をセットすると、とにかくこういうことになるらしいよ。
- (7)で、レコード数ぶんForループ。
- (8)からの３行。DataSourceオブジェクトのActiveRecord、FirstRecord、LastRecordの全てに同じ数字をセットすることで、１レコード１文書にしているのだと思う。
- (9)。よく分からんのだが、ここにDoEventsを入れていなかったら、ひたすら白紙文書がレコード数ぶん生産される。
- (10)で、新しくできるドキュメントのファイル名を作成。DataField(フィールド名)オブジェクトのValueプロパティを使えば、当該レコードのフィールドの文字列を呼んでくることができる。
- (11)で、最初のページを削除している。イマイチ理屈が分からんのだが。Bookmarksコレクションってのがあるんでしょうな。すまん、勉強不足で。（＊）
- (12)では、SaveAsメソッドを用いて新しくできたドキュメント（「定型書簡○○」って名前になっている）に名前を付けて保存している。
実行
差込データソースはこんな風に作っておいた。
差込フィールドは、ドキュメントの２ページ目に、こんな風に設定。
１ページ目には、こんな風にコマンドボタンを置いておいて、
ThisDocumentモジュールに、
Private Sub CommandButton1_Click() Call insertionPrintAndCreateNewDoc End Sub
こんな風にコードを書いておく。
ボタンを押すと、
保存用フォルダが作られて、
こんな風にファイルが作られる。
試しに一つ開いてみると、
こんな感じ。
おわりに
ほとんど借り物みたいなコードですが、めちゃくちゃ便利で重宝しております。
追記
コチラもどうぞ！
さらに追記
写しPDF作成マクロ～(4)
クラスを組み合わせる
使用したクラス
それぞれのクラスの詳細については、リンク先をどうぞ。
標準モジュールのコード
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を終了している。
ざっとこんな感じ。
おわりに
他にも、リボンの表示／非表示を切り替えるコードとか、FileNameGetteクラスを使って、Wordドキュメントのフルパスとか、ハンコ用画像ファイルのフルパスを取得するコードなんかもあるけど、割愛。
あまり便利とかそういうのはないけど、こんなこともできますよ、ということで……。
クラスをクラスのフィールドにする
クラスをクラスのフィールドにする
クラスを丸ごとクラスのフィールドにしたらいいんじゃないか、と今さらながらに気がついた。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
フィールドとして名前、戦法、競走得点の３つを持ち、メソッドとしてデータをセットするsetDataと、自己紹介をするshowMyselfの２つを持つクラス。
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という２つのメソッドを持つクラスにした。
実行
標準モジュールに次のコードを書いて実行してみた。
標準モジュールのコード
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メソッドを実行。
実行結果
GambleRacerクラスのsetDataメソッドが実行された証。
GambleRacerクラスのshowMyselfメソッドが実行された。
KeirinRaceクラスのdoKeirinメソッドも無事実行された。
おわりに
ちょっと今まで「クラスの独立性」という概念を勘違いしていたのかも。まだまだ勉強が足りませんな。
小さなクラスを作る(6)～WordドキュメントをPDFに変換する
WordドキュメントをPDFに変換して保存する
仕様
- Wordドキュメント
- そのWordドキュメントがあるフォルダパス
- ファイル名
以上３つをフィールドとして持つ。
メソッドは今のところ一つだけ。
- 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)にあるように、引数は３つ。第１引数はWordドキュメントそのもの。第２引数は保存用のフォルダ名。第３引数は保存時にファイル名の先頭に加える文字列。Optionalなので省略可。
- (2)は、拡張子を除いたファイル名を入れるための変数。
- (3)で、拡張子を除いたファイル名を割り出す。
- (4)では、WordドキュメントオブジェクトのExportAsFixedFormatメソッドでPDFに変換・保存している。引数OutPutFileNameとExportFormatを指定して実行している。それぞれの引数が何を意味しているかは、コードを見たら分かると思う。
おわりに
なんだか、あんまりクラスにした意味が感じられないなあ。もっと柔軟な処理ができるようにした方がいいのかも。
まあ、でもこれで、写しPDF作成マクロに必要なものは出そろったので、ここらで写しPDF作成マクロシリーズに戻ることにしよう。
小さなクラスを作る(5)～エラーキャッチをするクラス
エラーキャッチをするクラスを作る
そんなことをする意味があるのかどうかはともかく、エラー時にメッセージを表示させるという処理もよく使うので、作ってみた。まあ、何でもかんでもクラスを作っていったら、そのうちコツがつかめるだろうということで勘弁してくださいｗ
例によって、クラスモジュールを挿入して、名前は「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 & _
"| ￣￣ ￣ | ち～んｗ" & vbCrLf & _
"| （＿人＿） |" & vbCrLf & _
"| ＼ | |" & vbCrLf & _
"＼ ＼＿| ／", vbCritical
End If
Err.Clear '……(4)'
End Sub
コードの説明
- (1)。引数は２つ指定。第１引数はエラーが発生した場所を表す文字列。第２引数は、「煽り」を入れるかどうか。完全に遊びですｗ
- (2)は、通常のエラー発生お知らせメッセージ。
- (3)。第２引数でTrueが渡されていたら、ユーザを煽るｗ
- (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メソッドを呼び出す
- 第２引数をTrueにしているので、エラーが出たら煽られる
まあ、こうなるはず。
無事にエラー内容が表示され、
煽られたｗｗｗ
おわりに
正直、こんなの必要なのかなあ、とは思う。
小さなクラスを作る(4)～フォルダ作成クラス
きっかけ
写しハンコつきPDFを作るマクロのコードを見直していると、メインの「写しPDFを作るクラス」が結構複雑なクラスになっていることが分かった。ざっと挙げると、
- 元のWordドキュメントに画像があるかどうかチェック
- ハンコ用の画像ファイルが実在するかチェック
- 各ページの先頭中央にハンコ画像を追加する
- 保存用のフォルダの有無をチェックし、なければ作る
- ハンコ画像付きのWordドキュメントをPDFに変換して保存
- Wordドキュメントを閉じてWordを終了
とまあ、これだけのことを一つのクラスの一つのメソッドに請け負わせていたことになる。
こうやって改めて書き出してみたら、イマイチだなあ……、とｗ
たとえば、４つ目の保存先のフォルダの有無をチェックし、なければ作るなんてのは、他のマクロでも頻出の処理だし、５つ目の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
構造体としてまとめた関係で、このように異様にシンプルになる。
メソッド部分
２つのメソッドを作ってみた。
'メソッド
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
１つ目のcheckExistenceOfFolderメソッド(1)は、その名の通り、指定したフォルダが存在するかどうかを調べるメソッド。存在していたらfdIsExistプロパティにTrueが格納される。それだけ。使い道があるのかどうかは不明ｗ
２つ目のcreteFolderメソッド(3)は、第１引数で指定したフォルダに、第２引数で指定した名前のフォルダがあるかどうかを調べて、なかったら作る、というもの。
コードの説明
- (1)からのcheckExistenceOfFolderメソッド。(2)では、Dir関数を使ってフォルダが存在するかどうか調べている。引数で指定したフォルダが存在しなかったら、Dir関数は""を返す。これはよく使うと思う。
- (3)からのcreteFolderメソッド。checkExistenceOfFolderメソッドと同じようにフォルダの有無を調べて、なかったら(4)でMkDirステートメントで新しいフォルダを作成している。
- 新たにフォルダを作成した場合は、元々フォルダが存在していた場合と区別するために、(5)でobjFolderプロパティのfdIsCreated要素（擬似的なプロパティ）をTrueにする。
おわりに
構造体の使用の是非はともかく、
他で使い回せるかどうか
を基準に、クラスを切り分けていくのが良いのかもしれない。
平成29年３月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)―ページ先頭位置を割り出して画像を追加する―
Wordドキュメントに画像を貼り付ける
今回作成するマクロでは、Wordドキュメントにpng画像を貼り付ける必要がある。しかも、その処理をExcelから行う、という無駄にややこしい仕様ｗ
とりあえず、今回は
Wordドキュメントの各ページの先頭中央にpng画像を貼り付ける
ことに特化して書く。
ExcelVBA使いにとって、WordVBAって、
似ているのに何かちょっとクセがつかみづらい
気がするので、自身の覚書も兼ねてちょっとこってり書くよ。
やるべきこと
ひとまず、やるべきことを整理しておこうかね。
参考文献は土屋和人さんの『Wordマクロ/ＶＢＡ徹底入門』という本。
WordVBA関連の情報ってホントに乏しくて、本屋で見つけて清水の舞台から飛び降りるつもりで定価購入した直後に敦賀のブックオフで500円ぐらいで売っていたのを見つけてずっこけたのは良い思い出だｗ
閑話休題。
- ドキュメントの先頭を選択する
- png画像を貼り付ける（追加する）
- Wordの「検索」機能を用いて改ページ位置を割り出す
- 改ページ位置の次の場所を選択する
- 改ページが見つからなくなるまで繰り返し
とまあ、これだけのことをやらせればよい。
使用したコード
下に挙げるコードは、クラスのメソッドとして書いたものの抜粋。従ってよく分からん変数が使われていると思うので、先に説明しておく。
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)
コードの説明
久しぶりに読んでみたら、すっかり意味を忘れていたのでｗ 復習も兼ねてしっかり説明しよう。
- (1)は、WordのRangeオブジェクトを格納するための変数の準備。このコードはExcelのモジュールに書いているので、型を指定するときに「Word.Range」と書いているところが注意かな。
※実は、私、これでしばしハマりました。 - (2)で、Wordドキュメントの0文字目～0文字目、つまり文書の先頭位置をobjRange_に格納している。
- (3)で、その位置を選択している。
- (4)で、png画像を追加。AddPictureメソッドを使用。Topプロパティの「0」はともかく、Leftプロパティの「200」は完全に目分量。
- いよいよ(5)からが本番。(5)～(9)の説明の前に画像をば。
スキルがないので、画像が汚くてすまん。そのうち勉強する。
赤で書き込んだのが今回使用するプロパティ。
- (5)では、SelectionオブジェクトのFindプロパティを参照。Withしているので、ここから先はFindオブジェクトに対する操作。
最初はコレが分からなかった。「Find」なんて言ったらメソッドだと思うよねえ……。このFindオブジェクトというのは、
こいつのことなんだな。
- (6)、(7)で、ワイルドカードとあいまい検索(日)をオフにしている。特にMatchFuzzyプロパティをFalseにしておかないと、この後の特殊文字の検索ができないので注意。
※ちなみにここでも相当長時間ハマりました。 - (8)で検索する対象をセット。「^m」ってのは「改ページ」を表す特殊文字。
- ここまでで検索の設定ができたので、(9)で検索を実行。「execute」ってのは、「exeファイル」でおなじみ、「実行する」って意味だよね。
- あと、Excecuteメソッドの引数「Forward」ってのは「次を検索」ってやつだな。
ちなみに、この時点で、「Selection」オブジェクトの「End」プロパティには「171」が入っていることが分かる。
Wordの方では、改ページ記号が選択されている。
- (10)で、現在選択中の最後の場所の次の場所、すなわち、次のページの先頭を新たにobjRangeにセット。
- (11)でその場所を選択。
- (12)は繰り返し判定。検索の結果、検索対象が見つかっていなければ、FindオブジェクトのFoundプロパティにFalseが返るので、その場合はループを抜ける、ということ。
おわりに
WordVBAって、いまいち使いどころがよく分からないけれど、このFindオブジェクトの使い方はしっかり身につけておいたら、いろいろ面白そうだ。
