へっぽこヘタレシステム管理者の管理人です。
暫く前から悪戦苦闘している【WordのVBA】ですが・・・
とりあえず、やりたいことがなんとかできたので、忘備録として掲載しておきます。
やりたいことは次のとおりです。
- １：ワードのセクション１は飛ばしてセクション２からVBAを実行する
- ２：１行ごとに文字列を判断し行頭にインデント（字下げ）があるか判断する
- ３：行頭にスペースが１つ入っているか（手動による字下げ）があるか判断する
- ４：２と３の場合は、行の先頭に【図形等で〇】を付ける
【〇】は行頭【本文内】ではなく、ちょっと離れた場所に図形等でおきたいという・・・
複雑な条件です。
従来はリンクされたテキストボックスがいくつも配置された様式だったのですが・・・
これは、不意にテキストボックス自体が選択した状態で・・・
文字を消すためのバックスペースキーを押しでもすれば・・・
テキストボックス自体が消えてしまうという事が多々あり非常に使いにくいものでした。
テキストボックスがリンクされているので、下手すれば、ページ単位で全文が消える事もあります。
こういうくだらない様式美にこだわるところも・・・
ある意味、役所なのですが、非効率的・非生産的であることには間違いありません。
しかし、これをやめるという事は考えないようです。
さて、実際につくったコードは次のとおりです。
かなり長いですが・・・
コメント細かく付けてありますので、コードの意味は分かるかと思います。
Sub test()
ActiveDocument.Sections(2).Range.Select 'セクション２の全文を選択
With Selection
.MoveLeft Unit:=wdCharacter, Count:=1 'カーソルを左に（セクション２の行頭にカーソル移動）
' .EndKey Unit:=wdLine, Extend:=wdExtend '行を選択
End With
'********************
'変数設定 ここから
'********************
Dim numIndent As Integer 'インデント位置の格納
Dim numPage As Integer 'ページ数を格納
Dim fstCHAR As Variant '最初の一文字を格納
Dim lstCHAR As Variant '最後の一文字を格納
Dim beforeCRLF As Variant '前の行の最後が改行かどうか
beforeVBCRLF = True '初期値は改行有りとする
Dim dicMaru As Variant
Set dicMaru = CreateObject("Scripting.Dictionary") '〇を格納する連想配列【dictionary】を作成
dicMaru.RemoveAll 'ディクショナリーの全てのキーとアイテムペアを削除する
dicMaru.Add 1, "" '１ページ目は質問文のため１ページ目にはキーだけの空行を追加する
'********************
'変数設定 ここまで
'********************
'本文の１行毎に処理する ここから
For i = 1 To 20000
Selection.EndKey Unit:=wdLine, Extend:=wdExtend '行を選択
numIndent = Selection.ParagraphFormat.FirstLineIndent 'インデントを取得
numPage = Selection.Information(wdActiveEndPageNumber) 'ページ数を取得
fstCHAR = Left(Selection.Text, 1) '行の最初の１文字
lstCHAR = Right(Selection.Text, 1) '行の最後の１文字
' 前の行の最後の文字が改行コード かつ
' 行が空白ではない かつ
' インデント有り 又は 最初の１文字が空白ではない かつ
' 【次ページ有り】が含まれない
' 場合だったら・・・
If beforeVBCRLF = True _
And (Replace(Trim(Selection.Text), vbCr, "") <> "") _
And (numIndent > 0 Or fstCHAR = " ") _
And InStr(1, Selection.Text, "ABCDE") = 0 _
Then
' Selection.InsertBefore "〇" 'テスト用 行頭に〇を付けて確認 通常はコメントアウト
dicMaru(numPage) = dicMaru(numPage) & "〇" & vbCrLf
Else
dicMaru(numPage) = dicMaru(numPage) & vbCrLf
End If
' 行の最後の文字が改行が改行なら【beforeVBCRLF = True】とする
If (lstCHAR = vbCrLf Or lstCHAR = vbCr Or lstCHAR = vbLf) Then
beforeVBCRLF = True
Else
beforeVBCRLF = False
End If
' 最後の文字だったらループから抜ける
If Selection.Range.End = ThisDocument.Content.End Then
Exit For
End If
Selection.MoveDown Unit:=wdLine, Count:=1 '次の行を選択
Selection.HomeKey Unit:=wdLine 'カーソルを行頭に
Next i
'本文の１行毎に処理する ここまで
' 連想配列【dictionary】に格納したテキストをワードのヘッダに
' 配置したテキストボックス内に【IF文】のフィールドコードを追加する
' IF文を入れる図形を指定
Set spText = ThisDocument.Sections(2).Headers(1).Shapes(1) 'Shapes(*)の番号は注意
Set frText = spText.TextFrame.TextRange
With spText
.Fill.Visible = msoFalse '塗りつぶし無し
.Line.Visible = msoFalse '枠線無し
.Visible = msoFalse '隠す
End With
frText.Delete 'テキストボックスを空にする
frText.Select 'テキストボックスを選択
'テキストボックスに格納するフィールドコードの記載を作成する ここから
For i = 0 To dicMaru.Count - 1
With Selection
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False 'CTRL+F9と同じ
.TypeText Text:="IF"
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False 'CTRL+F9と同じ
.TypeText Text:="PAGE"
.MoveRight Unit:=wdCharacter, Count:=2 '
.TypeText Text:=" ="
.TypeText Text:=Space(1)
.TypeText Text:=i + 1
.TypeText Text:=Space(1)
.TypeText Text:=""""
.TypeText Text:=dicMaru.Item(i + 1)
.TypeText Text:=""""
End With
Next
Selection.TypeText Text:="" '最後の【ELSE】に【""】を挿入
'テキストボックスに格納するフィールドコードの記載を作成する ここまで
Set dicMaru = Nothing '配列【dictionary】を空にする
frText.Fields.Update 'フィールドの更新
spText.Visible = msoTrue '再表示
' 本文の始めに移動
ActiveDocument.Sections(2).Range.Select 'セクション２の全文を選択
With Selection
.MoveLeft Unit:=wdCharacter, Count:=1 'カーソルを左に（セクション２の行頭にカーソル移動）
End With
' テスト用のデバッグプリント 確認時に使用する
' Debug.Print spText.TextFrame.TextRange
' For i = 0 To dicMaru.Count - 1
' Debug.Print dicMaru.keys()(i) & " " & dicMaru.items()(i)
' Next
End Sub以下コードの説明
セクション２の全文を選択
ActiveDocument.Sections(2).Range.Selectカーソルを左に（セクション２の行頭にカーソル移動）
With Selection
.MoveLeft Unit:=wdCharacter, Count:=1
End With
' Count:=1 の後に Extend:=wdExtend を記載すると範囲選択となる連想配列【ディクショナリー】の作成し、初期化する
Dim dicMaru As Variant
Set dicMaru = CreateObject("Scripting.Dictionary")
dicMaru.RemoveAll連想配列を最後に空にする（コードの最後には必ず空にする）
Set dicMaru = Nothing配列に文字列【ABCDE】を格納
下の例の場合はキー番号（X）に文字列を追加する
dicMaru(X) = dicMaru(X) & "ABCDE"カーソルのある行を全選択
Selection.EndKey Unit:=wdLine, Extend:=wdExtendカーソルのある行のインデントを取得
numIndent = Selection.ParagraphFormat.FirstLineIndentカーソルのある行のページ数を取得
numPage = Selection.Information(wdActiveEndPageNumber)選択した行の最初の１文字を取得
fstCHAR = Left(Selection.Text, 1)選択した行の最後の１文字を取得
lstCHAR = Right(Selection.Text, 1)選択した行が空白ではない場合（改行コードも削除して）
Replace(Trim(Selection.Text), vbCr, "") <> ""文字列【ABCDE】が含まれていない場合
InStr(1, Selection.Text, "ABCDE") = 0選択した範囲の前に【ABCDE】を挿入
Selection.InsertBefore "ABCDE"選択した範囲の後に【ABCDE】を挿入
Selection.InsertAfter "ABCDE"VB上の改行コードは次のとおり
vbCrLf 又は vbCr 又は vbLf選択した範囲の最後の文字数
Selection.Range.End
ブログランキングにご協力ください！
ドキュメントの最後の文字数
ThisDocument.Content.End次の行に移動（カーソルの下キー）
Selection.MoveDown Unit:=wdLine, Count:=1カーソルを行頭に移動
Selection.HomeKey Unit:=wdLineテキストボックスの等のシェイプを選択カッコ内の番号に注意
オブジェクト変数【Set】で代入することもOK
ThisDocument.Sections(2).Headers(1).Shapes(1).select
Set X = ThisDocument.Sections(2).Headers(1).Shapes(1)さらにテキストボックスをオブジェクト変数【Set】で代入
Set Y = ThisDocument.Sections(2).Headers(1).Shapes(1).TextFrame.TextRangeシェイプを非表示・表示
ThisDocument.Sections(2).Headers(1).Shapes(1).Visible = False
ThisDocument.Sections(2).Headers(1).Shapes(1).Visible = Trueテキストボックスを空に
ThisDocument.Sections(2).Headers(1).Shapes(1).TextFrame.TextRange.Deleteテキストボックスを選択
ThisDocument.Sections(2).Headers(1).Shapes(1).TextFrame.TextRange.Select選択したテキストボックスに空のフィールドコードを追加
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False選択したテキストボックスに文字列【ABCDE】を挿入
Selection.TypeText Text:="ABCDE"選択したテキストボックスに半角スペースを挿入
カッコ内の数字スペースの数を指定
Selecton.TypeText Text:=Space(1)選択したテキストボックスに【”】を挿入
【”】の数に注意
Selection.TypeText Text:=""""選択したテキストボックス【フィールド】を更新
Selection.Fields.Update
コメント