字下げインデントを解除できない?(Word)
字下げインデントを解除できない?
実に不可思議な現象に出くわしたのでメモ。
なお、未解決である。
字下げインデントを解除する方法
段落の字下げインデントを司っているのは、ParagraphFormat
オブジェクトのFirstLineIndent
プロパティ。
理屈の上では、コイツの値を0
にしてやれば、字下げインデントなしの状態にできるはずである。
そこで、カーソルのある段落の字下げインデントを解除するためのコードは次のようになる。
リスト1
Public Sub OffFirstLineIndent() Selection.ParagraphFormat.FirstLineIndent = 0 End Sub
これで万全のはずである。
一点の曇りもない。
いざ、実行!
満を持して、実際のドキュメントで試してみる。
いかがであろうか。
1段落目(「ビデオを使うと、」で始まる段落)では無反応なのに、2段落目(「Word に用意されている」で始まる段落)では、意図どおり字下げが解除されている。
おい、誰やねん。
プログラムは書いたとおりに動く!
とかほざいたやつは。
1段落目と2段落目の違い
実は、1段落目と2段落目は、字下げインデントの指定の仕方がちょっとだけ違うのである。
画像でお見せしよう。
おわかりだろうか。
1段落目が、字下げインデントの幅を「1 字
」と文字数単位で指定しているのに対し、2段落目では「3.7 mm
」とミリ単位で指定しているのである。(「3.7 mm
」は、10.5ポイントの1字分の近似値。)
結論
どうも、
FirstLineIndent
の値をマイナスにする。)を設定することができないっぽい。
おわりに
これは、実に困ったことである。
なんでVBAでクラスモジュールを使うのか
なんでVBAでクラスモジュールを使うのか
基本的には標準モジュールで十分
プログラムを書くときに、モノとして扱った方が楽な場合がある。
モノの機能だけが欲しいのなら、標準モジュールでいい。
機能のまとまりを表す名前を付けて、その中にメソッドをまとめておくのである。
たとえば、ユーザに選ばせたフォルダのフォルダパスを取得するという処理がある。
FileDialog
オブジェクトを使う処理だが、毎回いちいちFileDialog
オブジェクトを取得してフォルダパスを返す処理を書くのはめんどくさい。 だから、FileDialog
オブジェクトをラップしたメソッドを書く。
Option Explicit Private m_FSO As Object Public Function GetSelectedFolderPath( _ Optional ByVal a_DefaultDir As String, _ Optional ByVal a_Title As String) As String If m_FSO Is Nothing Then Set m_FSO = CreateObject("Scripting.FileSystemObject") Dim ret As String ret = "" '第1引数省略なら最初に表示するディレクトリをこのブックのある' 'ディレクトリにする ' If a_DefaultDir = "" Then _ a_DefaultDir = ThisWorkbook.Path If Not m_FSO.FolderExists(a_DefaultDir) Then _ a_DefaultDir = ThisWorkbook.Path Dim folderPath As String Dim isSelected As Boolean Dim folderPicker As FileDialog Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker) With folderPicker .InitialFileName = a_DefaultDir If a_Title <> "" Then .Title = a_Title Else .Title = "フォルダ選択" End If isSelected = .Show If isSelected Then ret = .SelectedItems(1) Else ret = "" End If End With GetSelectedFolderPath = ret End Function
このように、たとえばFileDialogUtil
という標準モジュールに、GetSelectedFolderPath
というメソッドを作っておくと、あとは、
Dim rootDir As String rootDir = FileDialogUtil.GetSelectedFolderPath
というコードを書くだけで、〝ユーザが選択したフォルダのフルパスを取得する〟という処理が書けるようになる。
この調子で、FileDialog
オブジェクトを利用する処理を、標準モジュールFileDialogUtil
にまとめておくと、以後プログラムを書くのが非常に楽になる。
このように、FileDialog
というモノが使いたい場合でも、機能が欲しいだけなら標準モジュールで十分である。
〝運用でカバー〟的にはなるが、〝メソッド呼び出し時には、必ずモジュール名を記述する〟というルールで用いれば、〝静的クラス〟のような使い方ができる。
クラスモジュールを使いたくなるとき
では、どういうときにクラスモジュールを使いたくなるか。
上記FileDialogUtil
では、モノ自体、つまり利用しようとするFileDialog
オブジェクト自体には〝個性〟はなくてもよかった。
利用するFileDialog
は、いついかなるときでも〝タダのFileDialog
オブジェクト〟なのであって、色も味も身長も体重も、一切の特徴がない〝タダのFileDialog
オブジェクト〟である。
それに対して次のような場合はどうか。
このような場合である。
「〝ある〟テキストファイル」なので、そのモノには個性がある。
〝その〟テキストファイルのファイルパスであったり、〝その〟テキストファイルの内容(要するにテキストデータ)であったり、トータルの行数であったり。
だいたい、プログラムの中でテキストファイルを扱いたいという場合、〝テキストファイルの機能〟を使いたい、という場合はないと思う。(そんな状況は、想像できない。)
このような場面のはずである。
そうすると、たとえば、
があったら、非常に便利なはずである。
しかしながら、デフォルトではそのように振る舞ってくれる便利なオブジェクトは存在しない。
このようなときにクラスモジュールを使いたくなる。
上記の例でいえば、
を自作するのである。
標準モジュールにメソッドを書いて上記の処理を実現しようと思ったら、必要になるその都度、そのメソッドに当該テキストファイルのフルパスを渡す必要がある。(テキストファイルをテキストファイルというモノとして変数に入れて保持する方法がないのだから、当たり前である。)テキストファイルを開き、読み込んだり書き込んだりする処理自体はまとめておくことができるものの、この〝テキストファイルのフルパスを渡す〟という手順自体は(基本的に)飛ばすことができない。
たとえば、テキストファイルのフルパスと行番号を渡して、当該テキストファイルの当該行のテキストを取得するGetTextData(FilePath As String, LineNumber As Long)
というメソッドがあったとする。
そうして、たとえば変数tmp
に、そのテキストファイルの3行目と5行目のテキストを結合して代入したい場合、次のようなコードを書くことになる。
Dim tmp As String tmp = GetTextData("X:\hoge\hoge.txt", 3) & GetTextData("X:\hoge\hoge.txt", 5)
これは非常にめんどくさい上、直感的でない。〝テキストファイルそのもの〟を指し示すオブジェクトが(基本的には)ないので、毎度毎度当該テキストファイルのフルパスを指定することになる。(もちろん、Scripting.TextStreamオブジェクトを使うとか、一旦読み込んだテキストファイルの内容を配列に入れてしまうとか、方法はある。)
その点、たとえば、次のような機能を持ったEasyTextFile
というクラスがあったとする。
Path
プロパティは、そのテキストファイルのフルパスを表す。Item(LineNumber)
メソッドは、指定した行(引数LineNumber
)にあるテキストデータを返す。
そうすると、上記「変数tmp
に、そのテキストファイルの3
行目と5
行目のテキストを結合して代入」するという処理は、次のようなコードで書ける。
Dim etf As New EasyTextFile etf.Path = "X:\hoge\hoge.txt" Dim tmp = String tmp = etf.Item(3) & etf.Item(5)
処理の例が単純なので、有難味を感じにくいかも知れないが、ここで用いた「hoge.txt
」のデータをプログラム内で参照する回数が増えるほど、恩恵を感じやすくなるはずである。 特に、一つのプログラム内で複数種類のテキストファイルを取り扱わなければならない場合に、より一層便利に感じるはずである。 たとえば、メールを自動で作成するプログラムで、
- 宛名人に関するデータをRecipient.txtから
- 差出人に関するデータをSender.txtから
- 本文に関するデータをMailBody.txtから
それぞれ取り出して使うとする。
上記クラスモジュールEasyTextFile
を用いるなら、たとえば、それぞれ
recipientData
senderData
bodyData
のように、役割明示的な変数名を付けてインスタンス化すれば、かなりコードの可読性が上がるはずである。
結論
〝個性のあるモノ〟をプログラム内で扱いたいときに、クラスモジュールを使いたくなる。
おわりに
素人の感想です。
EasyTextFileクラスは今……
EasyTextFileクラスは今……
クラスモジュールのコード
ただ、クラスモジュールのコードを晒すだけ……。
たぶん、盛大にヌケやモレがあると思うし、そもそもTextStream
オブジェクトのこととかADOSteram
オブジェクトのことをろくに理解もせずに、手探りで書いたようなコードなので、ツッコミどころだらけだと思う。
達人の皆さんのご指南を仰ぎたく思う。
リスト1 クラスモジュール:EasyTextFile
Option Explicit '設定用のテキストファイルを扱うためだけに使うクラス' '必要最小限の機能にとどめる' '2021-09-18現在の機能' '・テキスト読み込み' '・行のテキストの書きかえ' '・行の追記:Appendメソッド' '・テキストファイルの上書き保存:Saveメソッド' '・テキストファイルの別名保存:SaveAsメソッド' 'Public enums' 'Enumerations for Scripting.FileSystemObject object' Public Enum TFCharCode tfShiftJIS = 0 tfUTF8 = 1 tfUTF16 = -1 ' tfUseDefault = -2' End Enum 'Private enums' 'Enumerations for ADODB.Stream object' Private Enum StreamTypeEnum adTypeBinary = 1 adTypeText = 2 End Enum Private Enum SaveOptionsEnum adSaveCreateNotExist = 1 adSaveCreateOverWrite = 2 End Enum Private Enum StreamReadEnum adReadAll = -1 adReadLine = -2 End Enum Private Enum StreamWriteEnum adWriteChar = 0 adWriteLine = 1 End Enum 'Enumerations for Scripting.FileSystemObject' Private Enum IOMode ForReading = 1 ForWriting = 2 ForAppending = 8 End Enum Private Enum Tristate TristateFalse = 0 TristateTrue = -1 TristateUseDefault = 2 End Enum 'Enumerations for error' Private Enum TFErrType tfErrNotInitialized = 1 tfErrFileNotExist tfErrArgInvalid End Enum 'Constants' Private Const ERR_NUMBER As Long = 10000 'Module level variables' '実行時バインディングにしている' Private m_FSO As Object Private m_TextStream As Object Private m_ADOStream As Object 'Field variables' Private m_Path As String Private m_TextLines As Collection Private m_Encoding As TFCharCode Private m_HasInitialized As Boolean 'Constructor' Private Sub Class_Initialize() Set m_FSO = CreateObject("Scripting.FileSystemObject") Set m_ADOStream = CreateObject("ADODB.Stream") Set m_TextLines = New Collection End Sub Public Sub Init(ByVal a_Path As String, _ ByVal a_CharCode As TFCharCode) 'If file not exists, raise error.' If Not m_FSO.FileExists(a_Path) Then Call raiseError(tfErrFileNotExist) End If 'LinesTextに値があったら一旦全部消しておく' '※Collectionの要素は上書きができないため' Dim i As Long Dim cnt As Long cnt = m_TextLines.Count If cnt > 0 Then For i = 1 To cnt Call m_TextLines.Remove(CStr(i)) Next End If m_Path = a_Path m_HasInitialized = True Dim tmp As String Dim n As Long n = 1 m_Encoding = a_CharCode Select Case m_Encoding Case tfUTF8 'UTF-8のテキスト読み込み' With m_ADOStream .Charset = "UTF-8" 'ストリームを開いてファイルをロードする' Call .Open Call .LoadFromFile(Me.Path) '1行づつテキストを読み込む' Do Until .EOS tmp = .ReadText(adReadLine) Call m_TextLines.Add(tmp, CStr(n)) n = n + 1 Loop End With '読み込みが終わったら閉じる' Call m_ADOStream.Close Case tfShiftJIS 'Shift_JISのテキスト読み込み' Call readFromTextSteram(tfShiftJIS) Case tfUTF16 'UTF-16のテキスト読み込み' Call readFromTextSteram(tfUTF16) End Select End Sub Private Sub readFromTextSteram(ByVal a_CharCode As TFCharCode) Set m_TextStream = m_FSO.OpenTextFile(FileName:=Me.Path, _ IOMode:=ForReading, _ Create:=False, _ Format:=a_CharCode) Dim tmp As String Dim n As Long n = 1 With m_TextStream Do Until .AtEndOfStream tmp = .ReadLine Call m_TextLines.Add(Item:=tmp, Key:=CStr(n)) n = n + 1 Loop End With Call m_TextStream.Close End Sub 'Destructor' Private Sub Class_Terminate() Set m_ADOStream = Nothing Set m_TextStream = Nothing Set m_TextLines = Nothing End Sub 'Properties' Public Property Get Path() As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Path = m_Path End Property Public Property Let Path(ByVal a_Path As String) If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) m_Path = a_Path End Property Public Property Get Encoding() As String Dim ret As String Select Case m_Encoding Case tfUTF8: ret = "UTF-8" Case tfShiftJIS: ret = "Shift_JIS" Case tfUTF16: ret = "UTF-16" End Select Encoding = ret End Property Public Property Get FileName() As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Dim ret As String ret = m_Path Dim arr() As String arr = Split(ret, "\") '" ret = arr(UBound(arr)) FileName = ret End Property Public Property Get LinesCount() As Long If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) LinesCount = m_TextLines.Count End Property Public Property Let LineText(ByVal a_index As Variant, _ ByVal a_Text As String) If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) If Not IsNumeric(a_index) Then Call raiseError(tfErrArgInvalid) If CLng(a_index) < 0 Or _ CLng(a_index) > Me.LinesCount Then Call raiseError(tfErrArgInvalid) '既存のアイテムを削除してから追加する' Call m_TextLines.Remove(CStr(a_index)) Call m_TextLines.Add(Item:=a_Text, _ Key:=CStr(a_index)) End Property Public Property Get LineText(ByVal a_index As Variant) As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) If Not IsNumeric(a_index) Then Call raiseError(tfErrArgInvalid) If CLng(a_index) < 0 Or _ CLng(a_index) > Me.LinesCount Then Call raiseError(tfErrArgInvalid) LineText = m_TextLines.Item(CStr(a_index)) End Property 'Methods' Public Sub Append(ByVal a_Text As String) If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Dim cnt As Long cnt = m_TextLines.Count Call m_TextLines.Add(Item:=a_Text, _ Key:=CStr(cnt + 1)) End Sub Public Sub Save() If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Select Case m_Encoding 'UTF-8' Case tfUTF8 Call SaveAs(Me.Path) 'Shif_JIS or UTF-16' Case tfShiftJIS Call SaveAs(Me.Path) Case tfUTF16 Call SaveAs(Me.Path) End Select End Sub Public Sub SaveAs(ByVal a_Path As String) If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Select Case m_Encoding 'UTF-8' Case tfUTF8 Call writeUTF8TextFile(a_Path) 'Shif_JIS or UTF-16' Case tfShiftJIS Call writeToTextStream(a_Path, tfShiftJIS) Case tfUTF16 Call writeToTextStream(a_Path, tfUTF16) End Select '最新の状態で読み込み直しておく' Call Me.Init(a_Path, m_Encoding) End Sub Private Sub writeUTF8TextFile(ByVal a_Path As String) Dim createNew As SaveOptionsEnum If m_FSO.FileExists(a_Path) Then createNew = adSaveCreateOverWrite Else createNew = adSaveCreateNotExist End If Dim i As Long With m_ADOStream .Charset = "UTF-8" Call .Open For i = 1 To Me.LinesCount Call .WriteText(Data:=Me.LineText(CStr(i)), _ Options:=adWriteLine) Next Call .SaveToFile(a_Path, createNew) Call .Close End With End Sub Private Sub writeToTextStream(ByVal a_Path As String, _ ByVal a_CharCode As TFCharCode) Dim createNew As Boolean If m_FSO.FileExists(a_Path) Then createNew = False Else createNew = True End If Set m_TextStream = m_FSO.OpenTextFile(FileName:=a_Path, _ IOMode:=ForWriting, _ Create:=createNew, _ Format:=a_CharCode) Dim i As Long With m_TextStream For i = 1 To Me.LinesCount Call .WriteLine(Me.LineText(CStr(i))) Next Call .Close End With End Sub 'Raise Error' Private Sub raiseError(ByVal a_ErrType As TFErrType) Call Err.Raise(Number:=ERR_NUMBER + a_ErrType, _ Description:=getErrMessage(a_ErrType)) Call Err.Clear End Sub Private Function getErrMessage( _ ByVal a_ErrType As TFErrType) As String Dim ret As String Select Case a_ErrType Case tfErrNotInitialized: ret = "Sorry, class has not initialized yet..." Case tfErrFileNotExist: ret = "Sorry, file not exists..." Case tfErrArgInvalid: ret = "Sorry,argument is invalid... " End Select getErrMessage = ret End Function
とりあえず、以上。
おわりに
外部ライブラリは全部実行時バインディングにしてあるので、まるごとコピッペすれば使えます。
ただし、New
した後に、必ずInit
メソッドを実行するようにしてください。
簡易版TextFileクラスを作った
簡易版TextFileクラスを作った
テキストファイルの扱いとか、FileSystemObject
のTextStream
オブジェクトとか、ADODB
オブジェクトあたりのことがよくわかっていないので、テキストファイルの中身を簡単に取得するためのクラスを作った。
クラスモジュールを触るのがめっちゃ久しぶりだったので、まあまあ苦戦した。
テキストファイルを読み込んで内容を保持するクラス
その名もEasyTextFile
クラス。
機能は最小限にした。
テキストファイルのパスと文字コード(いちおう、Shift_JIS
、UTF-8
、UTF-16
の3種類に対応している。ただ、私は素人なので、文字コードのこととか、実はよくわかっていない。)
まあ、Scripting.FileSystemObject
オブジェクトとADODB.Stream
オブジェクトをラップしているだけ。
リスト1
クラスモジュールEasyTextFile
Option Explicit '設定用のテキストファイルを読み込むためだけに使うクラス' '必要最小限の機能にとどめる' 'Public enums' 'Enumerations for Scripting.FileSystemObject object' Public Enum TFCharCode tfShiftJIS = 0 tfUTF8 = 1 tfUTF16 = -1 ' tfUseDefault = -2' End Enum 'Private enums' 'Enumerations for Scripting.FileSystemObject' Private Enum IOMode ForReading = 1 ForWriting = 2 ForAppending = 8 End Enum Private Enum Tristate TristateFalse = 0 TristateTrue = -1 TristateUseDefault = 2 End Enum 'Enumerations for error' Private Enum TFErrType tfErrNotInitialized = 1 tfErrFileNotExist tfErrArgInvalid End Enum 'Constants' Private Const ERR_NUMBER As Long = 10000 'Module level variables' Private m_FSO As Object Private m_TextStream As Object Private m_ADOStream As Object Private m_HasInitialized As Boolean 'Field variables' Private m_Path As String Private m_TextLines As Collection 'Constructor' Private Sub Class_Initialize() Set m_FSO = CreateObject("Scripting.FileSystemObject") Set m_ADOStream = CreateObject("ADODB.Stream") Set m_TextLines = New Collection End Sub Public Sub Init(ByVal a_Path As String, _ ByVal a_CharCode As TFCharCode) 'If file not exists, raise error.' If Not m_FSO.FileExists(a_Path) Then Call raiseError(tfErrFileNotExist) End If m_Path = a_Path m_HasInitialized = True Dim tmp As String Dim n As Long n = 1 Select Case a_CharCode Case tfUTF8 'UTF-8のテキスト読み込み' With m_ADOStream .Charset = "UTF-8" Call .Open Call .LoadFromFile(Me.Path) Do Until .EOS tmp = .ReadText(adReadLine) Call m_TextLines.Add(tmp, CStr(n)) n = n + 1 Loop End With '読み込みが終わったら閉じる' Call m_ADOStream.Close Case tfShiftJIS 'Shift_JISのテキスト読み込み' Call readFromTextSteram(tfShiftJIS) Case tfUTF16 'UTF-16のテキスト読み込み' Call readFromTextSteram(tfUTF16) End Select End Sub Private Sub readFromTextSteram(ByVal a_CharCode As TFCharCode) Set m_TextStream = m_FSO.OpenTextFile(FileName:=Me.Path, _ IOMode:=ForReading, _ Create:=False, _ Format:=a_CharCode) Dim tmp As String Dim n As Long n = 1 With m_TextStream Do Until .AtEndOfStream tmp = .ReadLine Call m_TextLines.Add(Item:=tmp, Key:=CStr(n)) n = n + 1 Loop End With Call m_TextStream.Close End Sub 'Destructor' Private Sub Class_Terminate() Set m_ADOStream = Nothing Set m_TextStream = Nothing Set m_TextLines = Nothing End Sub 'Properties' Public Property Get Path() As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Path = m_Path End Property Public Property Get FileName() As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) Dim ret As String ret = m_Path Dim arr() As String arr = Split(ret, "\") '" ret = arr(UBound(arr)) FileName = ret End Property Public Property Get LinesCount() As Long If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) LinesCount = m_TextLines.Count End Property Public Property Get LineText(ByVal a_Index As Variant) As String If Not m_HasInitialized Then Call raiseError(tfErrNotInitialized) If Not IsNumeric(a_Index) Then Call raiseError(tfErrArgInvalid) If CLng(a_Index) < 0 Or _ CLng(a_Index) > Me.LinesCount Then Call raiseError(tfErrArgInvalid) LineText = m_TextLines.Item(CStr(a_Index)) End Property 'Methods' 'Raise Error' Private Sub raiseError(ByVal a_ErrType As TFErrType) Call Err.Raise(Number:=ERR_NUMBER + a_ErrType, _ Description:=getErrMessage(a_ErrType)) Call Err.Clear End Sub Private Function getErrMessage( _ ByVal a_ErrType As TFErrType) As String Dim ret As String Select Case a_ErrType Case tfErrNotInitialized: ret = "Sorry, class has not initialized yet..." Case tfErrFileNotExist: ret = "Sorry, file not exists..." Case tfErrArgInvalid: ret = "Sorry,argument is invalid... " End Select getErrMessage = ret End Function
穴だらけなのだと思うけれど、一応エラー処理っぽいものも入れた。
使ってみる
準備
フォルダ内に、次の三つのテキストファイルを用意する。
上から順に、
このとおり。一つ目は、拡張子を.txt
ではなく、.aho
というわけのわからないものにしている。当然、中身はただのテキストファイルである。
ち~んwbyShiftJIS.txt
を開いたところ。
ち~んwbyUTF8.txt
を開いたところ。
ち~んw.aho
を開いたところ。
こんな感じ。
テキストファイルの内容をイミディエイトに出力するマクロ
たとえば、一つ目のち~んwbyShiftJIS.txt
の内容をイミディエイトに書き出すコードは次の通り。
リスト2
Private Sub test01() Dim etf As EasyTextFile Set etf = New EasyTextFile Dim flPath As String '===================================================================' flPath = ActiveDocument.Path & "\ち~んwbyShiftJIS.txt '" Call etf.Init(flPath, tfShiftJIS) '===================================================================' Debug.Print "Read from the file called """ & etf.FileName & """..." Dim i As Long For i = 1 To etf.LinesCount Debug.Print etf.LineText(i) Next End Sub
「===
」で囲ったところで、ファイルの指定と文字コードの指定をしている。
二つ目のち~んwbyUTF8.txt
なら、ここを
flPath = ActiveDocument.Path & "\ち~んwbyUTF8.txt" Call etf.Init(flPath, tfUTF8)
にすりゃいいし、三つ目のち~んw.aho
なら、
flPath = ActiveDocument.Path & "\ち~んw.aho" Call etf.Init(flPath, tfUTF8)
にするだけ。
実行結果
一つ目。
うむ。
二つ目。
ふむ。
むふふ。
バッチリである!
おわりに
特にWordなんかをVBAで動かすときには、処理用のデータをどこに置くかで困ることが多い。
私は、テキストファイルで外部化することが多いっす。
ドキュメントを量産するときに文字列を差し込む(Word)
ドキュメントを量産するときに文字列を差し込む(Word)
ドキュメントにデータを差し込むといえば、差し込み印刷機能を思い浮かべる人が多いと思うが、簡単なものならブックマーク機能を使ったら十分いける。
準備
前回
と同じドキュメント(笑)を使う。
その上で、次のようにブックマークを設定する。
これだけ。
ブックマーク部分に文字列を書き込むマクロ
前回記事のリスト1に手を加える。
リスト1
Private Sub test00() Const SRC_FOLDER As String = "\SrcDocument\" '" Const SRC_FILE_NAME As String = "SrcDocument.docx" Const SAVE_FOLDER As String = "\Products\" '" 'テンプレート用ファイルのフルパス組み立て' Dim srcPath As String srcPath = ThisDocument.Path & SRC_FOLDER & SRC_FILE_NAME '保存先フォルダパス' Dim saveDir As String saveDir = ThisDocument.Path & SAVE_FOLDER 'ファイル名の部品を取得’ '"" Dim psnNum As String psnNum = Format(2, "0#") Dim sectName As String sectName = "明訓" Dim psnName As String psnName = "山田 太郎" 'ファイル名組み立て' Dim flName As String flName = psnNum & psnName & "@" & sectName & ".docx" 'テンプレート用ファイルを開く' Dim templateDoc As Word.Document Set templateDoc = Word.Documents.Open(srcPath) '名前を付けて保存' Call templateDoc.SaveAs2(saveDir & flName) '==========================================================' 'ブックマーク箇所に文字列を書き込む' With templateDoc .Bookmarks("PersonNumber").Range.Text = psnNum .Bookmarks("SectionName").Range.Text = sectName .Bookmarks("PersonName").Range.Text = psnName End With '==========================================================' '上書き保存して閉じる' Call templateDoc.Close(SaveChanges:=True) '……(*) End Sub
「===
」で挟んだ部分を追加し、(*)
の部分を変えた。
[Bookmarks]("index").Range
で、ブックマークした部分のRange
オブジェクトが取得できるので、そのText
プロパティに値をセットしてやればよい。
これで、あたかもブックマーク部分に文字列を差し込んだかのような効果が得られるのである!
使ってみる
万全。
おわりに
[Bookmark]Range
オブジェクトのText
プロパティを直接書き換えると、ブックマークは消失します。
新しくできたドキュメントを汚さないという意味では便利なのかも知れませんが、これがありがたいことなのかどうか、よくわかりません。
あと、やっとWordのRange
オブジェクトがちょっとわかってきたような気もします。気のせいでしょうけど。
Document.SaveAs2メソッドでドキュメントを量産する(Word)
[Document].SaveAs2メソッドでドキュメントを量産する(Word)
同じ内容のドキュメントを、名前だけ変えて量産したい。
準備
まず、元になるドキュメント(笑)を準備する。
こいつを、ファイル名を変えて別のフォルダに保存する。
フォルダ構成は、
こんな感じ。
Mass-ProductDocuments.docm
が、今回司令塔になるドキュメント。
Products
フォルダは、名前を変えて保存するときの保存先。大量生産したときは、ここに新たにできたドキュメントがたまってゆく。
SrcDocument
フォルダには、大量生産するための元のドキュメントを入れておく。
ちなみに、中身は
このとおり。SrcDocument.docx
というドキュメントが入っている。(上の「元になるドキュメント(笑)」のことね。)
ドキュメントを開き、別名で指定したフォルダに保存するマクロ
とりあえず、次の動作をするコードを書く。
- 元になるドキュメント(笑)を開く
- ファイル名を作る
- 作ったファイル名で別フォルダに保存する
これだけ。
リスト1
Private Sub test00() Const SRC_FOLDER As String = "\SrcDocument\" '" Const SRC_FILE_NAME As String = "SrcDocument.docx" Const SAVE_FOLDER As String = "\Products\" '" 'テンプレート用ファイルのフルパス組み立て' Dim srcPath As String srcPath = ThisDocument.Path & SRC_FOLDER & SRC_FILE_NAME '保存先フォルダパス' Dim saveDir As String saveDir = ThisDocument.Path & SAVE_FOLDER 'ファイル名の部品を取得’ '"" Dim psnNum As String psnNum = Format(2, "0#") '番号' Dim sectName As String sectName = "明訓" '所属' Dim psnName As String psnName = "山田 太郎" '名前' 'ファイル名組み立て' Dim flName As String flName = psnNum & psnName & "@" & sectName & ".docx" 'テンプレート用ファイルを開く' Dim templateDoc As Word.Document Set templateDoc = Word.Documents.Open(srcPath) '名前を付けて保存' Call templateDoc.SaveAs2(saveDir & flName) '閉じる' Call templateDoc.Close(SaveChanges:=False) End Sub
コードについては、コメントをごらんください。
リスト内の「'ファイル名の部品を取得'」のところは、今回はそれぞれ決め打ちにしているが、量産体制に入るときには、ファイル名用の部品をテキストファイルから取得するようにすればよい。
たとえば、テキストファイルに、1件あたり1行になるように、上の例でいうと「番号」、「所属」、「名前」をタブ区切りでデータを作成しておけば、1行分のテキストをSplit
で配列にしてやることで、ファイル名の作成に必要なデータを得ることができる。
あと、「名前を付けて保存」以下のところ。
SaveAs2
メソッドを実行した時点で、元の「SrcDocument.docx
」は、「02山田 太郎@明訓.docx
」になってしまう。(手作業のときと同じである。)
で、変数templateDoc
が指し示しているのも「02山田 太郎@明訓.docx
」になる。
したがって、最後の
Call templateDoc.Close(SaveChanges:=False)
を実行すると、「02山田 太郎@明訓.docx
」が閉じられ、後には司令塔の「Mass-ProductDocuments.docm
」だけが取り残される。
「SrcDocument.docx
」が開いたままになる、ということはない。
実行後
Products
フォルダの中身は、
このとおり。ちゃんと保存されている。
こいつを開くと、
当然、内容は元の「SrcDocument.docx
」と同じである。
おわりに
あとは、ファイル名のもとになるデータを用意して、ループさせれば大量生産が可能。
また、新しくできたドキュメントに、ちょっと手を加えて保存、ということもできる。
様式を大量生産して配布するときに便利です。
段落の末尾に文字列を追加する(Word)
段落の末尾に文字列を追加する(Word)
単なる個人的な覚え書き。
段落の末尾に文字列を追加するぐらい、簡単にできると思っていたが、意外に苦戦したので、記録として残しておく。
手っ取り早く結論だけ知りたい方はコチラ以降をどうぞ。
このようなドキュメント(笑)の最初の段落の末尾に文字列を挿入することを考える。
【失敗】[Paragraph].Range.InsertAfterメソッドを使う
対象の段落のParagraph
オブジェクトを取得し、そのRange
プロパティが返すRange
オブジェクトのInsertAfter
メソッドを使えばよいと考えた。
イミディエイトに次のコードを書く。
ActiveDocument.Paragraphs(1).Range.InsertAfter("ち~んw")
こいつを実行すると……。
あえなく失敗。まさに、「ち~んw」である。
【失敗】[Paragraph].Range.InsertBeforeメソッドを使う
では、〝2段落の前に挿入する〟と考えてはどうか。
イミディエイトに次のコードを書く。
ActiveDocument.Paragraphs(2).Range.InsertBefore("ち~んw")
対象の段落の次の段落のParagraph
オブジェクトを取得し、そのRange
プロパティが返すRange
オブジェクトのInsertBefore
メソッドを使えばよいと考えたのである。
結果は……。
ち~んw
【成功】段落末尾の位置を取得して[Range].InsertAfterメソッドを使う①
[Paragraph].Range
プロパティが返すRange
オブジェクトというのは、末尾の改段落まで含んでいるらしい。(当たり前だ。)
ならば、末尾の改段落を含まない部分のRange
オブジェクトを取得すればいいじゃないか。そう考えた。
リスト1
Private Sub test01() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Call tgtDoc.Paragraphs.Item(1).Range.Select '……(1)' Call Selection.MoveLeft(wdCharacter, 1, wdExtend) '……(2)' Call Selection.Range.Collapse(wdCollapseEnd) '……(3)' Call Selection.Range.InsertAfter("ち~んw") End Sub
我ながら、バカ丸出しのコードである。
(1)で第1段落のRange
オブジェクト全体を選択し、(2)で選択範囲を左に1文字分だけ縮めて、(3)で選択範囲の末尾に向けて選択範囲を潰す。
これで、第1段落の改段落マーク直前のところにカーソルが置かれるので、そのRange
オブジェクトのInsertAfter
メソッドを使っている。
やっとできた。
【成功】段落末尾の位置を取得して[Range].InsertAfterメソッドを使う②
しかし、先のやり方は、あまりにもぶさいくである。
よく考えたら、[Paragraph].Range
でRange
オブジェクトが取れる、ということは、その開始位置と終了位置が取れる、ということだ。Start
プロパティとEnd
プロパティで。
だったら、対象のDocument
オブジェクトのRange
メソッドで〝最後の改段落マークを含まないRange
オブジェクト〟を取得すれば良いだけのことである。
リスト2
Private Sub test02() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Dim tgtRange As Range Set tgtRange = tgtDoc.Paragraphs.Item(1).Range Call tgtDoc.Range(tgtRange.Start, _ tgtRange.End - 1).InsertAfter("ち~んw") End Sub
うん。この方がスマートだね。
実行すると、
ほれ、このとおり。挿入語の文字列が無駄に選択状態にならないから、この方がやっぱりいいね。
おわりに
WordのVBAは、地味~な罠が至るところにあるので、ほんとに面白い。
まさに、〝男坂〟……。