へっぽこヘタレシステム管理者の管理人です。
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ページ目の処理を別にすることで・・・
なんとか実現できました。
本当はもっとスマートなやり方があるかと思いますが・・・
現状の管理人の実力ではこれが精一杯です。
コメント