【コード】特定の列のフォント書式を変更するWordマクロ

表の特定の列に対して文字列の色を変えたり蛍光ペンを付けたりフォントのサイズを変更したりすることがあります。

最近お客様からご依頼いただく案件でこのような処理がありました。

書類の書式を一括で変更する場合や、スタイルや手作業で書類を作った後の微調整に用います。

(実行前)

(実行後)

このマクロでできること

現在開かれている文書の1つめの表に対して処理をします。

表の1列目のフォントの色を赤にします。

マクロの解説

9、10、15、16行目で、処理対象の表を、現在文書の1つめの表に設定しています。

22~24行目で処理対象となる1列目を設定します。

Cellプロパティでセルを指定します。開始セルから終了セルを指定します。このあたり、Excelマクロと同じような記述です。Excelの場合にはCellsとなっていますが。

このマクロのミソですが、列をSelectionオブジェクトにしないといけないのです。Rangeオブジェクトのまま処理できると思ったのですができませんでした。

そういうわけで、処理対象を選択します。(26行目

7、12、13、30~33行目で、処理後にカーソル位置を戻すため、カーソル位置をRangeオブジェクトに設定しています。これは、処理前と処理後のカーソル位置を同じ位置にするための常套手段です。

マクロ


Sub 特定の列のフォント書式を変更する()

 Dim myDoc As Document
 Dim myTable As Table
 Dim myTableRange As Range
 Dim myRowMax As Integer
 Dim myRange As Range
 
 '現在の文書をmyDocオブジェクトに設定
 Set myDoc = ActiveDocument

 '現在のカーソル位置を設定
 Set myRange = Selection.Range
 
 '文書の1つめの表をmyTableオブジェクトに設定
 Set myTable = myDoc.Tables(1)

 'myTableの列数をmyRowMaxに代入
 myRowMax = myTable.Rows.Count

 'myTableの1列目をmyTableRangeに設定
 With myTable
  Set myTableRange = myDoc.Range(.Cell(1, 1).Range.Start, .Cell(myRowMax, 1).Range.End)
 End With

 myTableRange.Select

 Selection.Font.ColorIndex = wdRed

 'カーソル位置を元に戻す
 myRange.Select
 
 Set myRange = Nothing
 
End Sub

作成経緯

上記のマクロを作る前に、つくったのがマクロ参考1です。

マクロ参考1を実行すると、以下のようになります。Rangeオブジェクトで列を選択したいのですが、1列目だけを排他的に選択することができません。
そんなわけで、マクロ参考2を作成して、まず列を選択してからフォントの色を変えるという処理(Selectionオブジェクトでの処理)に変更しました。すると、このようになります。
1列目が選択されたままだとかっこわるいので、冒頭のマクロのように処理前のカーソル位置にカーソルを戻すようにしたのです。

セルのプロパティを取るときに、SelectionオブジェクトにするのかRangeオブジェクトにするのかで差がありますので注意が必要です。私もまだルール化できておらず、試行錯誤しています。

マクロ参考1


Sub 特定の列のフォント書式を変更する_参考1()

 Dim myDoc As Document
 Dim myTable As Table
 Dim myTableRange As Range
 Dim myRowMax As Integer

 '現在の文書をmyDocオブジェクトに設定
 Set myDoc = ActiveDocument

 '文書の1つめの表をmyTableオブジェクトに設定
 Set myTable = myDoc.Tables(1)

 'myTableの列数をmyRowMaxに代入
 myRowMax = myTable.Rows.Count

 'myTableの1列目をmyTableRangeに設定
 With myTable
  Set myTableRange = myDoc.Range(.Cell(1, 1).Range.Start, .Cell(myRowMax, 1).Range.End)
 End With

 myTableRange.Font.ColorIndex = wdRed

End Sub

マクロ参考2


Sub 特定の列のフォント書式を変更する_参考2()

 Dim myDoc As Document
 Dim myTable As Table
 Dim myTableRange As Range
 Dim myRowMax As Integer

 '現在の文書をmyDocオブジェクトに設定
 Set myDoc = ActiveDocument

 '文書の1つめの表をmyTableオブジェクトに設定
 Set myTable = myDoc.Tables(1)

 'myTableの列数をmyRowMaxに代入
 myRowMax = myTable.Rows.Count

 'myTableの1列目をmyTableRangeに設定
 With myTable
  Set myTableRange = myDoc.Range(.Cell(1, 1).Range.Start, .Cell(myRowMax, 1).Range.End)
 End With

 myTableRange.Select

 Selection.Font.ColorIndex = wdRed

End Sub

コメント

  1. おおぬま こうじ より:

    2列複数行の、第2列のいくつかの行の一部に、文字列Xがあり、各文字列Xを文字列Yに置換したいのですが、第2列を選択した状態で With Selection.Find を使い、
    .Text = mytxt1 と .Replacement.Text = mytxt2 とを用い、
    .Wrap = wdFindStop .MatchWildcards = True とし、
    Selection.Find.Execute Replace:=wdReplaceAll で処理すると、
    第1列の文字列Xについても文字列Yで置換してしまいます。
    第2列の文字列Xについてのみに処理を限定できません。限定できるのでしょうか。

    • 新田順也 より:

      おおぬまさん
      コメントをありがとうございます。
      プログラム文を全て見せていただけないでしょうか。
      私の環境では、列を選択した状態では選択された列のみが置換されました。
      おおぬまさんのプログラムでは、置換直前に選択が解除されてしまっているなど、何か別の処理が入っていないかご確認ください。

      Sub Sample()

      With Selection.Find
      .Text = mytxt1 ‘文字列X
      .Replacement.Text = mytxt2 ‘文字列Y
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchByte = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchFuzzy = False
      .MatchWildcards = True
      .Execute Replace:=wdReplaceAll
      End With

      End Sub

トップへ戻る