スポンサーリンク

050-VBA

WORDのVBA【マクロ】に悪戦苦闘する!最終章・作りたいモノが取り合えず作れたので忘備録として使いそうな記述を残しておく!

へっぽこヘタレシステム管理者の管理人です。

暫く前から悪戦苦闘している【WordのVBA】ですが・・・

とりあえず、やりたいことがなんとかできたので、忘備録として掲載しておきます。

やりたいことは次のとおりです。

  • 1:ワードのセクション1は飛ばしてセクション2からVBAを実行する
  • 2:1行ごとに文字列を判断し行頭にインデント(字下げ)があるか判断する
  • 3:行頭にスペースが1つ入っているか(手動による字下げ)があるか判断する
  • 4:2と3の場合は、行の先頭に【図形等で〇】を付ける

【〇】は行頭【本文内】ではなく、ちょっと離れた場所に図形等でおきたいという・・・

複雑な条件です。

従来はリンクされたテキストボックスがいくつも配置された様式だったのですが・・・

これは、不意にテキストボックス自体が選択した状態で・・・

文字を消すためのバックスペースキーを押しでもすれば・・・

テキストボックス自体が消えてしまうという事が多々あり非常に使いにくいものでした。

テキストボックスがリンクされているので、下手すれば、ページ単位で全文が消える事もあります。

こういうくだらない様式美にこだわるところも・・・

ある意味、役所なのですが、非効率的・非生産的であることには間違いありません。

しかし、これをやめるという事は考えないようです。

さて、実際につくったコードは次のとおりです。

かなり長いですが・・・

コメント細かく付けてありますので、コードの意味は分かるかと思います。

Sub test()

    ActiveDocument.Sections(2).Range.Select  'セクション2の全文を選択
        
    With Selection
        .MoveLeft Unit:=wdCharacter, Count:=1 'カーソルを左に(セクション2の行頭にカーソル移動)
'        .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, ""   '1ページ目は質問文のため1ページ目にはキーだけの空行を追加する
    
'********************
'変数設定 ここまで
'********************

'本文の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)  '行の最初の1文字
    lstCHAR = Right(Selection.Text, 1)  '行の最後の1文字

'   前の行の最後の文字が改行コード かつ
'   行が空白ではない かつ
'   インデント有り 又は 最初の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
'本文の1行毎に処理する ここまで

'   連想配列【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  'セクション2の全文を選択
        
    With Selection
        .MoveLeft Unit:=wdCharacter, Count:=1 'カーソルを左に(セクション2の行頭にカーソル移動)
    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

以下コードの説明

セクション2の全文を選択

ActiveDocument.Sections(2).Range.Select

カーソルを左に(セクション2の行頭にカーソル移動)

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)

選択した行の最初の1文字を取得

fstCHAR = Left(Selection.Text, 1)

選択した行の最後の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

ブログ開設に必要なドメイン取得、サーバーレンタル、ASPの登録等は、こちらのサイトから!

スポンサーリンク
スポンサーリンク

-050-VBA

執筆者:


comment

メールアドレスが公開されることはありません。

CAPTCHA


関連記事

ZOOM+Openmeetings+VideoCaptureでインターネットに接続されていないLAN環境でもWEBセミナーを受講できる

へっぽこヘタレシステム管理者の管理人です。 さて・・・ コロナ禍のせいで、なんでもかんでもZOOM等のWEB会議ソフトを使って、会議や講習会が開催され、その度に準備に呼ばれる面倒な日々を送っております …

相談業務の履歴管理!エクセル【EXCEL】のファイル共有ではかなり無理があるのでアクセス【ACCESS】でデータベースを共有する方法!

日々底辺を彷徨うヘタレなアラフィフオヤジの管理人です。 本日は・・・ ちょっと仕事の関係で他の部署から相談があり・・・ 相談業務の履歴管理について、アクセスで簡単なデータベースを作成しました。 従来の …

Access・サブフォームのフォントサイズの変え方&メニューバーを非表示にする方法!

へっぽこヘタレシステム管理者の管理人です。 さて、ある部署に頼まれて簡単なACCESSのシステムを作ったのですが・・・ サブフォームのフォントが小さい【デフォルトのフォントサイズは11】とクレームがあ …

EXCELやACCESSの関数やVBA・SQL文等の忘備録まとめ!

このページでは、管理人が良く使う次のソフト MS-EXCEL(エクセル) MS-ACCESS(アクセス) Oracle(オラクル)SQL について、良く使うけれどもすぐに忘れて、何度も調べ「関数やVB …

管理人的EXCELのショートカット忘備録!沢山あって覚えられないので最低限で・・・!

なにやら最近【EXCEL】関連の本が売れている様です。 管理人も日々エクセルは使っています。 職場にいって、【WORD】と【EXCEL】を立ち上げない日は無いと言っても過言ではりません。 しかし、これ …

スポンサーリンク
スポンサーリンク
スポンサーリンク