Sheetオブジェクトを変数にぶち込むと自作Propertyにアクセスできない?

Sheetオブジェクトの自作Propertyが呼び出せない?

Sheetオブジェクトをぶち込んだ変数からアクセスできない

前回の

akashi-keirin.hatenablog.com

で作成したPropertyに、Sheetオブジェクトをぶち込んだ変数からアクセスしようとしたらできなかった。

リスト1 標準モジュール
Public Sub testSheetProperty()
  Debug.Print Sheet3.LastRowNumber(4)    '……(1)'
  Dim Sh As Worksheet    '……(2)'
  Set Sh = Sheet3
  Debug.Print Sh.LastRowNumber(4)
End Sub

(1)の

Debug.Print Sheet3.LastRowNumber(4)

および(2)からの3行

Dim Sh As Worksheet
Set Sh = Sheet3
Debug.Print Sh.LastRowNumber(4)

ともに、Sheet3オブジェクトの自作Propertyを参照して、返り値をイミディエイトに表示しようとしている。

ところが、(2)の方、すなわち、Sheet3を変数Shにぶち込むやり方の場合、そもそもコード入力の時点で、

f:id:akashi_keirin:20180714213639j:plain

このように、Intellisenseが働かない。

で、実行すると、

f:id:akashi_keirin:20180714213648j:plain

このようににべもなくエラーになる。

(2)の部分をコメントアウトして実行すると、

f:id:akashi_keirin:20180714213657j:plain

このように意図どおりの結果が出る。当たり前だけれど。

おわりに

なんで変数にぶち込んだらPropertyにアクセスできないんだろう???

追記

id:imihitoさん、thom (id:t-hom)さんからコメントをいただいて、ある程度意味が分かってきました。

Sheet3オブジェクトは、Worksheetクラスを継承した子クラス、ないしはWorksheetインターフェイスを実装したクラス、と考えたら良いっぽい。

Worksheetクラスの子クラスの場合

今回のLastRowNumberプロパティは、あくまで子クラスSheet3クラスのプロパティなので、親クラスWorksheet型の変数からは呼び出せないことになる。

Worksheetインターフェイスを実装したクラスの場合

同じく、Worksheetインターフェイスには存在しないプロパティなので、Worksheetインターフェイス型の変数からは呼び出せない。

コードの修正

したがって、上記のリスト1を次のように修正する。

スト2 標準モジュール
Public Sub testSheetProperty()
  Debug.Print Sheet3.LastRowNumber(4)
  Dim Sh As Sheet3    '……(*)'
  Set Sh = Sheet3
  Debug.Print Sh.LastRowNumber(4)
End Sub

変えたのは(*)のところのみ。変数ShSheet3型にした。

確かに、

f:id:akashi_keirin:20180715103829j:plain

こんな風に、入力候補にSheet1Sheet2……というのが出てくる。

実行してみると、

f:id:akashi_keirin:20180715103846j:plain

今度は、意図どおりの結果となった。

っていうか、これ、基本的には

akashi-keirin.hatenablog.com

これと同じことなんだよなあ。なんで気づかなかったんだろう。

SheetモジュールにPropertyを設置する(Excel)

ワークシートにPropertyを新設する

Propertyプロシージャを使う

Propertyプロシージャというと、クラスモジュールで使うという印象だが(私だけ?)、標準モジュールだろうが、フォームモジュールだろうが、シートモジュールだろうが、何ならThisWorkbookモジュールにも置くことができる。

列の最終行を返すProperty

シートモジュールに、引数で指定した列の最終行を返すPropertyを設定してみた。

今回は、Sheet3オブジェクトのシートモジュールにPropertyを新設する。あ、Sheet3ってのに深い意味はありません。実験用のブックのSheet3が今回の実験に都合が良かったというだけ。

リスト1 Sheet3モジュール
Public Property Get LastRowNumber( _
         Optional ByVal columnNumber As Long = 1) As Long    '……(1)'
  LastRowNumber = getLastRowNumber(columnNumber)    '……(2)'
End Property

Private Function getLastRowNumber( _
          Optional ByVal columnNumber As Long = 1) As Long
  Dim lastRow As Long
  lastRow = Me.Cells(Rows.Count, columnNumber).End(xlUp).Row
  getLastRowNumber = lastRow
End Function

カンタンなコードなので、特に説明はいらないと思うが、一応。

(1)の

Public Property Get LastRowNumber( _
         Optional ByVal columnNumber As Long = 1) As Long

は、引数と返り値の設定。

Property Getというのは、Functionみたいなものなので、引数も指定できる。

ここでは、最終行を求める列の番号を引数としている。省略可にしており、省略されたときは「1」すなわちA列を指定することにした。

後は、(2)の

LastRowNumber = getLastRowNumber(columnNumber)

Functionを呼んで、返り値を返すだけ。

今回はメンドクサイので、最終行を求めるのに一番カンタンなEndプロパティを用いた方式を採用した。

当然、このやり方だとフィルター抽出されているようなときに意図しない結果になる。

気に入らなければFunctionの中身を変えたら良い。

実験

Sheet3は、

f:id:akashi_keirin:20180714211807j:plain

こんな感じ。

で、イミディエイトに

?sheet3.LastRowNumber(1)
?sheet3.LastRowNumber(3)
?sheet3.LastRowNumber(4)

と打ち込んで、それぞれ[Enter]してみる。

それぞれ、7115が返るはず。

f:id:akashi_keirin:20180714211816j:plain

ほれ。この通り。

おわりに

シートのPropertyにしてしまうことで、コードの可読性が上がるかも知れない。

Rangeプロパティの引数に定数・変数を使う(Excel)

Rangeプロパティの引数

通常、Rangeプロパティの引数と言えば、

[親オブジェクト].Range("A1")

のように、セルの番地を指定する。

しかしながら、このやり方だと、マジックナンバー的になってしまって、不便だなあと思っていた。

セルに名前を付ける、という方法もあるのだが、あまり濫発すると、

増田さんネームド化問題

を引き起こしてしまう。

定数で指定する

そこで、まず、セルの番地を定数にぶち込んでやってみる。

リスト1 標準モジュール
Private Const CELL_INDEX As String = "A1"

Public Sub testConstant()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Debug.Print Sh.Range(CELL_INDEX).Value
End Sub

ご覧のとおり、定数CELL_INDEXに、文字列A1をぶち込んでおき、

Debug.Print Sh.Range(CELL_INDEX).Value

で、A1セルの値(笑)をイミディエイトに表示させてみようという企て。

f:id:akashi_keirin:20180710200549j:plain

こんなふうに、A1セルに値(笑)を入力しておいて、実行してみる。

f:id:akashi_keirin:20180710200557j:plain

おお! ちゃんと動いた!

変数で指定する

ならば、今度は、変数でやってみる。

スト2 標準モジュール
Private Const CELL_INDEX As String = "A1"

Public Sub testConstant()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Debug.Print Sh.Range(CELL_INDEX).Value
  Dim cellIndex As String
  cellIndex = "A1"
  Debug.Print Sh.Range(cellIndex).Value
End Sub

見てのとおり、今度は、変数cellIndexに、文字列A1をぶち込んで、

Debug.Print Sh.Range(cellIndex).Value

で、A1セルの値(笑)をイミディエイトに表示させようという企て。

先ほどと同じ状態で実行してみると、

f:id:akashi_keirin:20180710200607j:plain

なんと、あっさり動いた!

結論

Rangeプロパティのインデックスは、定数や変数でも指定することができます。

おわりに

なんで、こんな簡単なことを今までやってこなかったのだろう。

ブックを閉じて別フォルダに移動する(Excel)

f:id:akashi_keirin:20180610191139p:plain

Excelブックを移動する

この時期、あちこちから集めたデータ(笑)を集約するという作業が頻発する。

この手の業務は、VBAを使って瞬殺する私にとっては痛くも痒くもない。しかしながら、職場全体で見ると、この手のアホみたいな作業に膨大な時間を費やすというのが多数派。

別に人助けというわけではないけれど、最近は進んで他人のためにコードを書いている。本業の大半がクソつまらないものなので、却ってストレス解消にもなるし。

ブックを閉じて別のフォルダへ移す

近況報告はこのぐらいにして本題。

あちこちから集めたデータ(笑)を集約する、という作業に必ずつきまとうのが、

ブックを閉じる→別のフォルダに移動する

という操作。

集まってくるExcelブックが、ろくに下処理をしていない(データの入力規則を当てたり、ブックやシートの保護をかけたり、といった処理をろくにしていない)ものなので、フルオートにするよりも、

一つ一つのブックを開いて確認するところまでは手動、集約用シートへの転記以降は自動

にする方が安全なんである。

よって、「ブックを閉じる→別のフォルダへ移動する」という操作はやたら出てくるのであった。

別にその都度書いてもそれほどメンドウでもないんだけれど、メソッド化してみたというわけ。

ブックを閉じて別フォルダに移動するメソッド

リスト1 標準モジュール
Public Function moveBook(ByVal targetBook As Workbook, _
                         ByVal oldFullPath As String, _
                         ByVal newFullPath As String, _
                Optional ByVal canSaveChanges As Boolean = False) As Boolean '……(1)'
On Error GoTo errorHandler
  Application.DisplayAlerts = False    '……(2)'
  Call targetBook.Close(SaveChanges:=canSaveChanges)    '……(3)'
  Name oldFullPath As newFullPath    '……(4)'
  moveBook = True    '……(5)'
errorHandler:    '……(6)'
  Application.DisplayAlerts = True
  If Not moveBook Then moveBook = False
End Function

まず(1)の

Public Function moveBook(ByVal targetBook As Workbook, _
                         ByVal oldFullPath As String, _
                         ByVal newFullPath As String, _
                Optional ByVal canSaveChanges As Boolean = False) As Boolean

で引数と返り値を設定。

第1引数targetBookは、処理対象のWorkbookオブジェクト。

第2引数oldFullPathは、処理対象ブックの移動前のフルパス。

第3引数newFullPathは、処理対象ブックの移動後のフルパス。

第4引数canSaveChangesは、処理対象ブックを閉じるときに保存するかどうか。通常、転記処理後に上書き保存などする必要はないと思うので、省略可にして既定値をFalseにしてある。

返り値はBoolean型。無事ブックの移動が出来たらTrue、失敗したらFalseを返す。

コード自体はアホみたいに簡単なので、特に説明の必要はないと思うが、一応簡単に。

(2)の

  Application.DisplayAlerts = False

で、一旦警告表示を止める。通常、転記処理では処理対象ブックに変更を加えることなどないと思うが、今回手伝った事案で処理対象ブックに加工しないと集約できない、というケースがあったのでw

次に(3)の

Call targetBook.Close(SaveChanges:=canSaveChanges)

で処理対象ブックを閉じる。

targetBook.Close SaveChanges:=canSaveChanges

でも良いと思うが、引数がハダカになるのはやっぱりキモチワルイので……。

「ママー、裸じゃイヤ!」みたいな感じです。

(4)の

Name oldFullPath As newFullPath

はおなじみNameステートメント

「旧フルパス」と「新フルパス」の順序がよくごっちゃになる(いや、「As」の意味を考えたら割とすぐに分かるんですけどね!)ので、メソッドの中に閉じ込めてしまったわけですよ。

そもそも、なんで「As」なんているんでしょうねえ? 「Name 目的語 補語」で「○○を××と名づける」なんだから、別にName [OldFullName], [NewFullName]でいいと思うんですけど。

(4)が無事実行できたら(エラーにならなければ)、無事フォルダ移動が終わったということなので、(5)の

moveBook = True

で返り値をTrueにする。

普通だったら、ここで即returnすりゃいいってもんだが、

Application.DisplayAlerts = True

を2回も書きたくないので、エラーキャッチ用のブロックである(6)からの3行を

errorHandler:
  Application.DisplayAlerts = True
  If Not moveBook Then moveBook = False

こんなふうにした。

途中でエラーが出た場合も、エラーが出なかった場合も、このブロック内を実行するようにした。

かといって、すでにブックの移動が無事に終わった場合にFalseを返されてはたまらないので、

If Not moveBook Then moveBook = False

この時点で返り値がTrueでない場合にのみFalseを返すようにした。

おわりに

まあ、メリットといえば、NameステートメントApplication.DisplayAlertsまわりをラップしてメインのコードから隔離できることぐらいですけど。

君は[Ctrl]+[J]というショートカットキーを知っていたか(VBE)

[Ctrl]+[J]というショートカットキー

[Ctrl]+[J]の働き

Twitterで、thom (id:t-hom) さんが教えてくださった。曰く、

識別子はCtrl+Jで入力候補でる

と。

え? そ、そうなんすか???

というわけでちょっとやってみた。

変数名の入力中に[Ctrl]+[J]

f:id:akashi_keirin:20180610175303j:plain

こんなふうに、変数targetRangeが宣言済みの状態で、tarまで入力して、[Ctrl]+[J]をポチッと押してみる。

f:id:akashi_keirin:20180610175314j:plain

うおお! ほんまや!

おわりに

「(゚Д゚)ハァ? そんなことも知らなかったの???」とか、笑わば笑え。

変数名を役割明示的にするために、変数名がむやみに長くなりがちなので、このワザを覚えたのは大きい。

カーソルを任意の位置に置く(Word)

f:id:akashi_keirin:20180610173412j:plain

カーソルを任意の位置に置く

たぶんWord2010のバグだと思うのだけれど、均等割付を施したところに差込フィールドがあると、差し込まれた後に字幅がおかしくなる。

職場のPCでしか遭遇しない症状なので、画像でお見せできないんだけれど、データが差し込まれた瞬間、字幅が異様に縮まってそのままになってしまう。

特に困るのは、

akashi-keirin.hatenablog.com

これを使ってレコードごとにドキュメントを作成したとき。

差し込むデータの文字数によって、字幅が広がったり狭まったりして、ガタガタになってしまう。

できあがったものを開いて、均等割付部分にカーソルを当てると元に戻るのだが、いちいち開いてはクリック、とかやっていたのでは、何のために自動化したのか分からない。

そこで、作成する文書に応じてRangeプロパティを使って

targetDocument.Range(1,1).Select

みたいなのを書いていた。

ところが、均等割付を施す場所なんて文書によってまちまちだから、テンプレートになる文書の均等割付の場所に応じてその都度指定するRangeプロパティの引数を調整する、という実にアホなことになっている。

Selection.GoToメソッド

「○ページ目の○行目の○文字目にカーソルを置く」ようなメソッドを作れば、少しは指定しやすくなると思って調べてみると、Selection.GoToメソッドというものを見つけた。

例によってMSDNのSelection.GoToメソッドのページによると、

指定した項目の直前の文字位置にカーソルを移動します。

という実に素っ気ない記述。引数が4種類あるけれど、それらは、

パラメータ
What

省略可能です。オブジェクト型 (Object) の値を指定します。選択範囲の移動先の項目の種類を指定します。使用できる定数は、WdGoToItem 列挙型の定数のいずれかです。

Which

省略可能です。オブジェクト型 (Object) の値を指定します。選択範囲の移動先を指定します。使用できる定数は、WdGoToDirection 列挙型の定数のいずれかです。

Count

省略可能です。オブジェクト型 (Object) の値を指定します。文書内の項目の番号を指定します。既定値は 1 です。

正の値のみ有効です。指定範囲または選択範囲より前にある項目を指定するには、引数 Which として wdGoToPrevious を使用し、Count の値を指定します。

Name

省略可能です。オブジェクト型 (Object) の値を指定します。引数 What に wdGoToBookmark、wdGoToComment、wdGoToField、wdGoToObject のいずれかを指定した場合、この引数は名前を指定します。

とのこと。

ちなみに、WdGoToItem列挙体については、同じくMSDNのWdGoToItem列挙体のページを、WdGoToDirection列挙体については、MSDNのWdGoToDirection列挙体のページをご覧ください。

○ページ○行目○文字目にカーソルを置くFunction

とりあえず、次のようなFunctionを作ってみた。

リスト1 標準モジュール
Public Function setCursor(ByVal targetPage As Long, _
                          ByVal targetLine As Long, _
                          ByVal targetCharacter As Long) As Boolean    '……(1)'
  If targetPage <= 0 Then GoTo Finalizer
  If targetLine <= 0 Then GoTo Finalizer
  If targetCharacter <= 0 Then GoTo Finalizer
On Error GoTo Finalizer
  Call Selection.GoTo(What:=wdGoToPage, _
                      Which:=wdGoToAbsolute, _
                      Count:=targetPage)    '……(2)'
  If targetLine = 1 Then    '……(3)'
  Else
    Call Selection.GoTo(What:=wdGoToLine, _
                        Which:=wdGoToRelative, _
                        Count:=targetLine - 1)
  End If
  Call Selection.MoveRight(Unit:=wdCharacter, _
                           Count:=targetCharacter - 1, _
													 Extend:=wdMove)    '……(4)'
  setCursor = True
  Exit Function
Finalizer:
  setCursor = False
End Function

まず、(1)の

Public Function setCursor(ByVal targetPage As Long, _
                          ByVal targetLine As Long, _
                          ByVal targetCharacter As Long) As Boolean

で引数と返り値の設定。

第1引数targetPageでページ数、

第2引数targetLineで何行目か、

第3引数targetCharacterで何文字目かを渡す。

返り値はBoolean型。成功したらTrue、失敗したらFalseを返す。

(2)の

Call Selection.GoTo(What:=wdGoToPage, _
                    Which:=wdGoToAbsolute, _
                    Count:=targetPage)

では、Selection.GoToメソッドを用いてまずはページ移動。

引数WhatwdGoToPageを指定しているのでページ単位の移動、引数WhichwdGoToAbsoluteを指定しているので、文書全体の引数Countページ目に移動することになる(と思う)。

次は行移動。

(3)の

If targetLine = 1 Then
Else
  Call Selection.GoTo(What:=wdGoToLine, _
                      Which:=wdGoToRelative, _
                      Count:=targetLine - 1)
End If

では、同じようにSelection.GoToメソッドを用いているが、今度はIfを用いている。

実は、にもあるように、Countの既定値が1で、ここが0になると、1と見なされるっぽいのだ。

従って、引数targetLine1(つまり○ページ目の1行目というとき)は、何もしない、ということになる。何もしない、ということを明示するためにあえてこのような書き方にした次第。

(2)実行直後にカーソルは引数targetPage目の先頭にあるので、引数WhichwdGoToRelativeにした。

このとき、Count1だと2行目先頭にカーソルが移動するようなので、targetLine - 1としている。

あとは(4)の

Call Selection.MoveRight(Unit:=wdCharacter, _
                         Count:=targetCharacter - 1, _
												 Extend:=wdMove)

Selection.MoveRightメソッドでtargetCharacter字目にカーソルを移動する。

Selection.MoveRightメソッドについては、MSDNのSelection.MoveRightメソッドのページをどうぞ。

おわりに

実は、未だにWordのSelectionというオブジェクトがよく分かっていない。っていうか、Wordのオブジェクトモデルそのものがよく分かっていない。きちんと勉強したいのだけれど、現状本業の勉強が忙しくて、Wordのオブジェクトモデルの勉強に手が回っていない。

もどかしいなあ。

Wordの「スタイル」をVBAで操作する(3) (Word)

「標準」スタイルのフォントを変更するメソッド

前回

akashi-keirin.hatenablog.com

のつづき。

一発で「標準」スタイルのフォント設定を変更することができるようなマクロを作ってみる。

リスト1 標準モジュール
'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim styleIndex As Long
  styleIndex = getStandardStyleIndex(ThisDocument)    '……(1)'
  If styleIndex = -1 Then Exit Sub    '……(6)'
  With ThisDocument
    Dim fontBeforeChange As String
    If isFarEast Then    '……(7)'
      fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
    Else
      fontBeforeChange = .Styles(styleIndex).Font.Name
    End If
  End With
On Error GoTo errorHandler
  With ThisDocument.Styles(styleIndex).Font    '……(8)'
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With ThisDocument    '……(9)'
    If isFarEast Then
      .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
    Else
      .Styles(styleIndex).Font.Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルのインデックス番号を取得する'
Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long    '……(2)'
  With targetDocument
    Dim i As Long
    For i = 1 To .Styles.Count    '……(3)'
      With .Styles(i)
        If .NameLocal = "標準" Then _
          getStandardStyleIndex = i: Exit Function    '……(4)'
      End With
    Next
  End With
  getStandardStyleIndex = -1    '……(5)'
End Function

メインはsetFontForStandardStyleプロシージャ。途中getStandardStyleIndexプロシージャを呼び出す、という形になっている。

まず、いきなり(1)の

styleIndex = getStandardStyleIndex(ThisDocument)

getStandardStyleIndexを呼び、返り値をstyleIndexに突っ込む。

getStandardStyleIndexプロシージャは、ドキュメントの「標準」スタイルのインデックス番号を割り出すFunction。

さっそく中身を見ていく。

まず(2)の

Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long

は、おなじみの引数設定と返り値設定。

対象のDocumentを受けとって、「標準」スタイルのインデックスを返す。

内部では、(3)からの5行(実質4行)

For i = 1 To .Styles.Count
  With .Styles(i)
    If .NameLocal = "標準" Then _
      getStandardStyleIndex = i: Exit Function    '……(4)'
  End With
Next

で、For ~ Nextを用いて「標準」スタイルのインデックス番号を割り出す。

(targetDocument).Styles(i)で取り出した一つ一つのDocument.Styleオブジェクトについて、(4)の

If .NameLocal = "標準" Then getStandardStyleIndex = i: Exit Function

NameLocalプロパティが「標準」かどうかを調べ、「標準」だったらその時点でのiの値をreturnする、というもの。

もし一致しなければ(異常事態だけれど)、Forループから抜けることになるので、(5)の

getStandardStyleIndex = -1

で「-1」(あり得ない値)をreturnする。

処理がsetFontForStandardStyleプロシージャに戻ってくると、すかさず(6)の

If styleIndex = -1 Then Exit Sub

で返り値チェック。

-1」が返っていたとしたら異常事態なので、何もせずにExitする。

(6)を無事通過したら、あとはメインの処理へ。

……とその前に下ごしらえを。(7)からの5行

If isFarEast Then    '……(7)'
  fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
Else
  fontBeforeChange = .Styles(styleIndex).Font.Name
End If

で、引数isFarEastの値に応じて処理を分ける。

isFarEastTrueだったら、現時点の日本語用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

逆に、isFarEastFalseだったら、現時点の英数字用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

この後の処理でエラーが出るなどして実行できなかったときに、フォント設定を元に戻すため。

やっとメインの処理。(8)からの4行

With ThisDocument.Styles(styleIndex).Font    '……(8)'
  If isFarEast Then .NameFarEast = fontName: Exit Sub
  If Not isFarEast Then .Name = fontName: Exit Sub
End With

で、Document.Style.FontオブジェクトのNameFarEastまたはNameプロパティを設定する。

このとき、存在しないフォント名を渡したとかでエラーが出たら、(9)からの7行

With ThisDocument
  If isFarEast Then
    .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
  Else
    .Styles(styleIndex).Font.Name = fontBeforeChange
  End If
End With

でフォント設定を元に戻すようにした。

使ってみる

getStandardStyleIndexプロシージャ

まずは、getStandardStyleIndexプロシージャを使ってみる。

イミディエイト・ウィンドウに、

?WdCommon.getStandardStyleIndex(ThisDocument)

と入力して[Enter]。

ちなみに、

akashi-keirin.hatenablog.com

このときにも紹介したように、Privateメソッドであっても、[モジュール名].[メソッド名]とすれば、イミディエイト・ウィンドウで実行することができる。

f:id:akashi_keirin:20180513162135j:plain

ちゃんと「194」が返っている。

setFontForStandardStyleプロシージャ

次のコードで実行してみる。

スト2 標準モジュール
Public Sub testSetFontForStandardStyle()
  Call setFontForStandardStyle("MS ゴシック", True)
End Sub

setFontForStandardStyleの引数fontNameに「"MS ゴシック"」を、引数isFarEastに「True」を渡しているだけ。意図どおりならば、日本語用フォントが「MS ゴシック」になるはず。

実行結果

f:id:akashi_keirin:20180513162144j:plain

この状態で実行すると、

f:id:akashi_keirin:20180513162153j:plain

こうなる。意図どおり。

このマクロをクイック アクセス ツール バーにでも仕込んでおいたら、1クリックで「標準」スタイルのフォント設定を変えることができるし、Dir関数、Documents.Openメソッドと組み合わせたらフルオートでフォルダ内一括変換とかもできそう。あんまり需要はないだろうけれど。

追記

コードを修正しました。

スト2 標準モジュール
'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim standardStyle As Style
  Set standardStyle = getStandardStyle(ThisDocument)
  If standardStyle Is Nothing Then Exit Sub
  With standardStyle.Font
    Dim fontBeforeChange As String
    If isFarEast Then
      fontBeforeChange = .NameFarEast
    Else
      fontBeforeChange = .Name
    End If
  End With
On Error GoTo errorHandler
  With standardStyle.Font
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With standardStyle.Font
    If isFarEast Then
      .NameFarEast = fontBeforeChange
    Else
      .Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルを取得する'
Private Function getStandardStyle( _
                   ByVal targetDocument As Document) As Style
  With targetDocument
    Dim targetStyle As Style
    For Each targetStyle In .Styles
      If targetStyle.NameLocal = "標準" Then _
          Set getStandardStyle = targetStyle: Exit Function
    Next
  End With
  Set getStandardStyle = Nothing
End Function

直接Styleオブジェクトを取得する形にしました。