議会用答弁様式のWordマクロを作成・カーソル移動・行番号取得・ページ番号取得・テキスト選択等!

スポンサーリンク
050-VBA

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

9月は議会の一般質問の時期ですが・・・

答弁調整をする部署より答弁様式を変えたいからこれまでの様式のマクロを直してくれと依頼がありました。

正直Wordのマクロはあまりやりたくありません。

何故なら・・・ネットで検索してもあまりヒットしないからです。

ChatGPTも使ってみましたがあまり役にはたちませんでした。

まぁWEBに情報がなければ・・・

さすがの文章生成AIでも取ってくる情報がないのでどうしようもありません。

すくない情報をもとになんとか作りましたが・・・

オーダーする方は簡単にできると思っているのか結構ギリギリで言ってくるので困ったものです。

ということで、このせいで管理人は残業しなければなりませんでした。

まさに底辺です。

カーソル移動・行番号取得・ページ番号取得・テキスト選択

やっていることは次の動画のとおり・・・

カーソル移動・行番号取得・ページ番号取得・テキスト選択等です。

次のページがあって、改行の関係(段落ごとに1行開けるローカル・ルールがあるため)で前のページの最後の行が空白の場合は・・・

次のページがあるという注釈を付けます。

また、改行の関係でページの最初の行が空白になってしまった場合は、

その行を削除するという便利機能を付けます。

たったこれだけなのですが・・・

1ページ目については、質問文の長さにより表の高さが変わります。

表の高さが変わると1ページ目の行数が可変になるので、これをどうやって制御しようかかなり悩みました。

スポンサーリンク

コード

コードの内容は次のとおりです。

まず全ページを検索して【次のページあるよ!】があったら一端削除します。

次に・・・

2ページ目の先頭にカーソルを移動して・・・

そこから1ページ目の最後の文字にカーソルを戻します。

1ページ目の最後の行のテキストを選択し・・・

スポンサーリンク

空白を削除・改行コードを空白に置換=空白

だったら・・・

【次のページあるよ!】を追加します。

2ページ目以降は・・・

ブログランキングにご協力ください!
ブログランキング・にほんブログ村へ

行数が18行に固定されるので・・・

行を1行ずつカーソル移動させ【18】で割った余りが【0】の行(つまり各ページの最後の行)であれば・・・

空白を削除・改行コードを空白に置換=空白

であれば・・・

【次のページあるよ!】を追加します。

また、2ページ目以降の1行目(【18】で割った余りが【1】の行)が空白だったら・・・

その行を削除します。

Private Sub 改行整理_Click()

    Application.ScreenUpdating = False
    
    Dim txtLine As String
    Dim numpage As Long
    Dim numIndent As Single

    '【次のページあるよ!】消す
    Call dellpage
    
    Call page_one

    Do
            
        '【次のページあるよ!】追加
        Call addpage
        
        '1行選択
        Selection.EndKey wdLine, wdExtend
        
        '文の最後にきたら終了
        If Selection.Range.End = ThisDocument.Content.End Then
            Exit Do
        End If
        
        '1文字進む(次行の先頭へ)
        Selection.Move Unit:=wdCharacter, Count:=1
        
    Loop
    
    Application.ScreenUpdating = True
    
    Selection.MoveRight
     
End Sub

Private Sub dellpage()


    '【次のページあるよ!】消す ここから
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = 【次のページあるよ!】
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .MatchFuzzy = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    '【次のページあるよ!】消す ここまで

End Sub
Sub addpage()
  '2ページ目以降の処理

    Dim numLIne As Integer
    Dim txtLine As String
    Dim numpage As Integer
        
            '2ページ以降の最後の行が空白なら【次のページあるよ!】挿入 ここから
            
            'ページ値取得
            numpage = Selection.Information(wdActiveEndPageNumber)
        
            '行番号取得
            numLIne = Selection.Information(wdFirstCharacterLineNumber)
                    
            '1行選択
            Selection.EndKey wdLine, wdExtend
            txtLine = Selection.Range.Text
            
            '【次のページあるよ!】挿入 ここから
            If numpage >= 2 And numLIne Mod 18 = 0 _
                And (Replace(Trim(txtLine), vbCr, "") = "") _
            Then
                Selection.EndKey wdLine, wdExtend
                Selection.InsertBefore 【次のページあるよ!】
                Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            End If

            '【次のページあるよ!】挿入 ここまで
        
            '1行目が空白なら1行詰める ここから
            If numpage >= 2 And numLIne Mod 18 = 1 _
                And (Replace(Trim(txtLine), vbCr, "") = "") _
            Then
                Selection.EndKey wdLine, wdExtend
                Selection.Text = Replace(txtLine, " ", "")
                Selection.Text = Replace(txtLine, " ", "")
                Selection.Text = Replace(txtLine, vbCr, "")
            End If
            '1行目が空白なら1行詰める ここまで
        
            Selection.MoveLeft

End Sub
Sub page_one()
            '1ページ目の処理

            Dim txtLine As String
        
            '2ページ目にカーソル移動する
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=2
            
            '1ページ目の最後にカーソルを戻す
             Selection.Move Unit:=wdCharacter, Count:=-1
             
            '1行選択
             Selection.HomeKey wdLine, wdExtend
             txtLine = Selection.Range.Text
             
                If Replace(Trim(txtLine), vbCr, "") = "" Then
                    Selection.EndKey wdLine, wdExtend
                    Selection.InsertBefore 【次のページあるよ!】
                    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                End If
     
            Selection.MoveLeft

End Sub

1ページ目の行数が可変となるので・・・

どうしたら良いかかなり悩みましたが・・・

1ページ目と2ページ目の処理を別にすることで・・・

なんとか実現できました。

本当はもっとスマートなやり方があるかと思いますが・・・

現状の管理人の実力ではこれが精一杯です。

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

コメント

タイトルとURLをコピーしました