えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

トップ > Excel > Excelから游ゴシック体を徹底的に駆逐する Part3

Excelから游ゴシック体を徹底的に駆逐する Part3

Excel VBA 駆逐シリーズ

游ゴシック大嫌いな同志諸君！お久しぶりです。ことりちゅんです。

ついに！ついに、Excelからレイアウトを崩さずに游フォントを完全に消し去る最強のマクロが完成しましたのでご報告申し上げます。

本記事は「Excelから游ゴシック体を徹底的に駆逐する」の第三弾になります。

※游ゴシックが好きな人は気分を害する恐れがあるので、この先は読まずにお引取りください。

f:id:Kotori-ChunChun:20190721000217p:plain

前回のえくせるちゅんちゅん

第一弾では

  1. Excelにおける游ゴシックの問題点
  2. 手動で游ゴシックを取り除く方法
  3. 游ゴシックがエクセルに埋め込まれるのを防ぐ方法

などを説明していました。

www.excel-chunchun.com


第二弾では

第一弾の「3.游ゴシックがエクセルに埋め込まれるのを防ぐ方法」をスクリプトを半常駐させることにより、アップデートによる復活に対抗しました。

www.excel-chunchun.com


今回のえくせるちゅんちゅん

第三弾では

第一弾で書いた手動で游ゴシックを取り除いていた作業を、VBAにより自動化したものになります。

何故「游ゴシックを取り除く必要があるのか」は、第一弾の序盤を読み返して頂けると幸いです。

と言っても、リンクを飛ぶのが面倒な人のために・・・問題の趣旨を示した動画を追加しました。

f:id:Kotori-ChunChun:20190721174949g:plain

完成品のダウンロードは、記事の最後にあります。


今回のマクロ開発における要件はこんな感じ。

  • 使い方はワンクリックで。
    • マクロボタンをポチッと押したら游ゴシック消え去る！
  • レイアウトを壊さない。
    • 既存のブックの行の高さが変わってレイアウトが壊れないように！
  • やるからには徹底的に。
    • ブック内に「游」が一欠片も残らないように！

きっと「新しいエクセル(游ゴシック)で作ったブック」と「古いエクセル（MS P）で作ったブック」の間で、コピーしたりシートを移動したい場合に必須のマクロとなる事でしょう。

追記

なぜMS Pゴシックに合わせるのか

メイリオ、Meiryo UIではだめなのか

というコメントを頂いていますが、昔のエクセルで作成したデータはMS Pゴシックなので、新旧２つのブックをマージする時はどちらかのフォントに合わせるのが無難です。

11ポイントの文字の行の高さが、MS Pゴシックでは13.50(18ピクセル)なのに対して、游ゴシックでは18.75(25ピクセル)にもなります。※PCの画面によって数値は異なる

大きな枠に小さな文字を収めるのは簡単ですが、小さな枠に大きな文字を収めるのはレイアウトを破壊しないことには難しいです。

したがってMS Pゴシックのほうに合わせるというのが一般的です。

しかし、現在は游ゴシックベースで作成される様式も増えてきているので、将来的には主張がひっくり返ることが予想されます。

（というか、一部の業界を除いて、既に游ゴシックで作成していると思います）

なお、メイリオやMeiryoUIだと「行の高さ」がMS Pゴシックとも、游ゴシックとも違うため、やっぱりレイアウトが崩れてしまいます。これを関係機関共通の標準フォントとして採用するのは現実的ではないでしょう。あと「列の幅」も変わってしまうという問題があります。

（任意のセルに個別に付与するフォントを制限しているつもりはありません。今回の問題は游ゴシックによって環境依存で行の高さが変化する事なので。）


説明の流れ

本記事は

  • 各操作を行うだけの簡単なプロシージャを作成
  • 動作をデバッグ
  • 未解決の問題を洗い出し

その後、

  • 各プロシージャを関数化
  • 全ての関数を呼び出すプロシージャを作成
  • 全体としての動作をデバッグ

という、ボトムアップ開発の流れに沿って説明しています。

初心者の方には関数化する際の考え方の参考になるかもしれません。


フォント変更VBA

全てのセルのフォントを変更

VBA

Sub 全てのセルのフォントを変更()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Cells.Font.Name = "ＭＳ Ｐゴシック"
    Next
End Sub

結果

このマクロを実行すると、以下のように変化します。

f:id:Kotori-ChunChun:20190720150131g:plain

課題リスト

しかし、この方法には以下のような問題があるため使い物になりません。

課題 状態
行の高さが変わってしまう NEW
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう NEW
游フォントでないセルまでフォントが変わってしまう NEW
図の游フォントが変わらない NEW


行の高さを固定

フォントが変わっても行の高さが変わらないように「行の高さの自動調整」を解除します。

VBA

高さを固定する時は、行の高さを数値で設定してやればOKです。

シート全体に適用すると処理時間が大変なことになるので、A1から使用済み範囲に留めます。

Sub 行の高さを固定に変更()
    With ActiveSheet
        Dim rng As Range
        For Each rng In .Range(.Cells(1, 1), .UsedRange).EntireRow
            rng.RowHeight = rng.RowHeight
        Next
    End With
End Sub

戻す時はこんなふうにAutoFitを使います。

Sub 行の高さを自動に変更()
    With ActiveSheet
        Dim rng As Range
        For Each rng In .Range(.Cells(1, 1), .UsedRange).EntireRow
            rng.AutoFit
        Next
    End With
End Sub

※もともと固定されていた行も自動になってしまうため、100%の再現性を得るには固定する前に状態を保持する工夫が必要です。

課題リスト

課題 状態
行の高さが変わってしまう 解決
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう 未
游フォントでないセルまでフォントが変わってしまう 未
図の游フォントが変わらない 未


スタイル定義を変更

第一弾でも書きましたが、結局の所「セルのスタイル」の「標準」のフォントを変えないことには

  • 例えばセルを切り取りした時に（状況による）
  • 例えば「書式のクリア」を実行した時に

游ゴシックが何度でも蘇ります。

GUI

f:id:Kotori-ChunChun:20190720161057p:plain

VBA

Sub セルのスタイルの游フォントをMSPフォントに変更()
    Dim st As Style
    For Each st In ActiveWorkbook.Styles
        With st.font
            Select Case .Name
                Case "游ゴシック": .Name = "ＭＳ Ｐゴシック"
                Case "游明朝": .Name = "ＭＳ Ｐ明朝"
            End Select
        End With
    Next
End Sub

ついでに元に戻すコード

Sub セルのスタイルのMSPフォントを游フォントに変更()
    Dim st As Style
    For Each st In ActiveWorkbook.Styles
        With st.font
            Select Case .Name
                Case "ＭＳ Ｐゴシック": .Name = "游ゴシック"
                Case "ＭＳ Ｐ明朝": .Name = "游明朝"
            End Select
        End With
    Next
End Sub

※もともとMSPの箇所も游フォントに変わってしまうため、100%の再現性を得るには何らかの方法で前の状態を保持する必要があります。

また、第一弾に記載したように「標準」スタイルが「標準 2」などに増殖済みの可能性もあるので、「標準」から始まるスタイルは全部消してしまいましょう。

※デフォルトの「標準」はStyle.Nameでは「Normal」になるので対象外。そもそも削除出来ません。

Sub ニセ標準スタイル削除()
    On Error Resume Next
        With ActiveWorkbook
            Dim i As Long
            For i = .Styles.Count To 1 Step -1
                If .Styles(i).Name Like "標準*" Then
                    .Styles(i).Delete
                End If
            Next
        End With
    On Error GoTo 0
End Sub

結果

f:id:Kotori-ChunChun:20190721142809g:plain

課題リスト

課題 状態
行の高さが変わってしまう 済
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう 解決
游フォントでないセルまでフォントが変わってしまう 解決
図の游フォントが変わらない 未
セルの游フォントが完全に解除されない NEW

無関係なフォントが上書きされる問題は解決しましたが、新たに「手動で設定した游フォント」が解除されなくなってしまいました。


フォントテーマを変更

図のフォント（の既定値）はフォントテーマで決まります。

GUI

f:id:Kotori-ChunChun:20190720160257p:plain

VBA

マクロの記録を使って調べました。

パス直打ちなのでExcelのバージョンやビット数によって変わりそうな気がします。

Sub Officeフォントテーマを2007に変更()
    ActiveWorkbook.Theme.ThemeFontScheme.Load ( _
        "C:\Program Files (x86)\Microsoft Office\Root\Document Themes 16\Theme Fonts\Office 2007 - 2010.xml" _
        )
End Sub

ついでに変えたからには戻したいところですが、テーマを戻す操作を記録するとVBAは下記のようにモジュールコンパイルすら出来ない状態になりました。

ActiveWorkbook.Theme.ThemeFontScheme.Load()
'コンパイルエラー:
'構文エラー

f:id:Kotori-ChunChun:20190721123406p:plain

Excelが作ったプログラムがコンパイルエラーってどういうことや！？

モジュールコンパイルできる状態＝先頭にCallをつけたところ、今後はプロシージャコンパイルが出来ませんでした。

Call ActiveWorkbook.Theme.ThemeFontScheme.Load
'コンパイルエラー:
'引数は省略できません。

仕方ないのでvbNullStringを渡してみたところ、今度は実行時エラーになりました。

Call ActiveWorkbook.Theme.ThemeFontScheme.Load(vbNullString)
'-2147024809
'指定された値は境界を超えています｡

公式ドキュメントを調べて見ましたが、DeleteやResetやClearみたいな元に戻す方法は何処にも記載されていませんでした。

まあ游ゴシックに戻すなんてことはしないので、見なかったことにしましょう。

結果

f:id:Kotori-ChunChun:20190720160228g:plain

課題リスト

課題 状態
行の高さが変わってしまう 済
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう 済
游フォントでないセルまでフォントが変わってしまう 済
図の游フォントが変わらない 解決
セルの游フォントが完全に解除されない 未解決
図の游フォントが完全に解除されない NEW

セルのフォントと同じで、図のフォントを手動で設定している場合に游ゴシックが生き残る場合があります。


セルの游フォントを直接変更

手動設定された游フォントがまだ生き残っているので、地道に巡回して削除していきます。

VBA

通常パターン（1セルづつ置換していく方式）

Sub セルの游フォントをMSPフォントに変更()
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        With rng.Font
            Select Case .Name
                Case "游ゴシック": .Name = "ＭＳ Ｐゴシック"
                Case "游明朝": .Name = "ＭＳ Ｐ明朝"
            End Select
        End With
    Next
End Sub

別パターン（Find関数で抽出してから一気に変更する方式）

Sub セルの游フォントをMSPフォントに変更_Find()
    On Error Resume Next
        FontFind(ActiveSheet.Cells, "游ゴシック").Font.Name = "ＭＳ Ｐゴシック"
        FontFind(ActiveSheet.Cells, "游明朝").Font.Name = "ＭＳ Ｐ明朝"
    On Error GoTo 0
End Sub

'セル範囲のうちあるフォントのセルを全て検索して返す
Function FontFind(region As Range, findFontName As String) As Range
    With Application.FindFormat
        .Clear
        .Font.Name = findFontName
    End With
    
    Dim rng As Range
    Dim firstAddress As String
    With region
        Set rng = .Find(what:="*", SearchFormat:=True)
        If Not rng Is Nothing Then
            firstAddress = rng.Address
            Dim rngNext As Range: Set rngNext = rng
            Do
                '※書式検索ではFindNextは使えない
                Set rngNext = .Find(what:="*", after:=rngNext, SearchFormat:=True)
                If rngNext Is Nothing Then Exit Do
                Set rng = Union(rng, rngNext)
            Loop Until rngNext.Address = firstAddress
        End If
    End With
    
    Debug.Print rng.Address
    Set FontFind = rng
End Function

書いてはみたけど無駄に長くなってしまったので、こちらは使いません。

対象となるセルの数が増えると、もしかしたらこちらのほうが高速かもしれません。

結果

f:id:Kotori-ChunChun:20190721142846g:plain

課題リスト

課題 状態
行の高さが変わってしまう 済
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう 済
游フォントでないセルまでフォントが変わってしまう 済
図の游フォントが変わらない 済
セルの游フォントが完全に解除されない 解決
図の游フォントが完全に解除されない 未


図の游フォントを強引に変更

図のフォントも規定値でないものが生き残っているので、強引に一つづつ潰していきます。

VBA失敗例

Sub 図の游フォントをMSPフォントに変更_失敗()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        '※TextFrame2はExcel 2007以降
        If shp.TextFrame2.HasText Then
            With shp.TextFrame2.TextRange.Font
                Select Case .Name
                    Case "游ゴシック": .Name = "ＭＳ Ｐゴシック"
                    Case "游明朝": .Name = "ＭＳ Ｐ明朝"
                End Select
            End With
        End If
    Next
End Sub

ところが、この方法ではフォントが変わりませんでした。

よく調べてみると、「英数字用のフォント」だけが変わったようです。

f:id:Kotori-ChunChun:20190720203915p:plain

ここをVBAで触った経験が無いので、一度オブジェクトの仕様を調べてみました。

f:id:Kotori-ChunChun:20190720203854p:plain

えー。Name多すぎない！？

しかし以下の２つを設定すれば良いようです。

  • .Nameプロパティは英数字用フォント
  • .NameFarEastプロパティは日本語用フォント

VBA成功例

Sub 図の游フォントをMSPフォントに変更_成功()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        '※TextFrame2はExcel 2007以降
        If shp.TextFrame2.HasText Then
            With shp.TextFrame2.TextRange.Font
                Select Case .Name
                    Case "游ゴシック": .Name = "ＭＳ Ｐゴシック"
                    Case "游明朝": .Name = "ＭＳ Ｐ明朝"
                End Select
                Select Case .NameFarEast
                    Case "游ゴシック": .NameFarEast = "ＭＳ Ｐゴシック"
                    Case "游明朝": .NameFarEast = "ＭＳ Ｐ明朝"
                End Select
            End With
        End If
    Next
End Sub

結果

f:id:Kotori-ChunChun:20190720204554g:plain

課題リスト

課題 状態
行の高さが変わってしまう 済
「切り取り」や「書式のクリア」すると游ゴシックが復活してしまう 済
游フォントでないセルまでフォントが変わってしまう 済
図の游フォントが変わらない 済
セルの游フォントが完全に解除されない 済
図の游フォントが完全に解除されない 解決


ヘッダ・フッタのフォントを変更

調べていたら、ヘッダ・フッタにもフォントが使われていました。

フォント未設定の場合は、既定のスタイル「標準」のフォントに従うようで、その場合はヘッダ文字列にフォント名が含まれないため消すことが出来ません。

逆に言えば、スタイル定義を変えることで連動して変わります。

下記マクロは「標準」が游ゴシックではない時に、手動で游ゴシックを選択していた場合のみに意味があります。

VBA

Sub ヘッダフッタの游フォントをMSPフォントに変更()
    Dim ps As PageSetup: Set ps = ActiveSheet.PageSetup
    With ps
        'Replaceだと游ゴシックというヘッダフッタ文字列を置換してしまうバグあり
        If HeaderFooterFont(.LeftHeader) = "游ゴシック" Then
            .LeftFooter = Replace(.LeftFooter, "游ゴシック", "ＭＳ Ｐゴシック")
        End If
        If HeaderFooterFont(.CenterHeader) = "游ゴシック" Then
            .CenterHeader = Replace(.CenterHeader, "游ゴシック", "ＭＳ Ｐゴシック")
        End If
        '以下略
    End With
End Sub

'ヘッダ・フッタのフォント文字列を返す
'文字データのみの時　　：　bbbb
'フォント設定時　　　　：　&"HGP創英角ﾎﾟｯﾌﾟ体,標準"dddd
'フォント、サイズ設定時：　&"游ゴシック,標準"&16ああああ
'太字・斜体・下線設定時：　&"-,太字 斜体"&Uああああ
'登録して消した通常時　：　&"+,標準"ああああ
Function HeaderFooterFont(hfValue As String) As String
    Dim S() As String
    S = Split(hfValue, """")
    If UBound(S, 1) > 0 Then
        HeaderFooterFont = Split(S(1), ",")(0)
    End If
End Function

このままでは.LeftHeaderや.CenterHeaderが6回続くことになるのが気持ち悪いですが、これ以上美しいロジックが思いつかず、これで妥協しました。（悔しい！）

Replaceを使っているため、ヘッダフッタの文字列の中に「游ゴシック」という単語があったら誤認して置換してしまうというバグがあります。


各種VBAを抽象化

游フォントの種類について

抽象化するに当たって、游フォントにはどんな種類があるのかが問題となりました。

とりあえず現在のPCでフォントを開いてみたところ・・・

f:id:Kotori-ChunChun:20190721123520p:plain

「游ゴシック」が２個あるように見えるんですが！？

これについては、VBAでFont.Nameを取得すると、先に出てきた方は「Yu Gothic」になる事がわかったので大丈夫でした。

しかし・・・実際には別の名前２つがFont.Nameで取得した時に重複する事例がありました。

  • 游ゴシック
  • 游ゴシック Light

表示上「游ゴシック」なのは「Yu Gothic」になって、別のナニカがFont.Nameで「游ゴシック」になっている・・・？意味わからん。

フォントの設定では名称を代入するだけなので、識別方法はないと思われます。

今回のマクロには影響は無いので、とりあえず無視しました。

一覧取得VBA

フォントを列挙するVBAは以下の通りです。

Function フォント一覧()
    With Application.CommandBars("Formatting").Controls(1)
        Dim i As Long
        For i = 1 To .ListCount
            Debug.Print .List(i)
        Next
    End With
End Function

これを動かして初めて知ったのですが、ブックによってフォントの種類が違うことが分かりました。

一覧取得結果（例）

Yu Gothic Medium
Yu Gothic UI
Yu Gothic UI Light
Yu Gothic UI Semibold
Yu Gothic UI Semilight
游ゴシック
游ゴシック Light
游ゴシック Medium
游明朝
游明朝 Demibold
游明朝 Light

これらの結果から、フォント名の法則を導き出し、YuGothicと繋がっているパターンもあると伺い、このように関数化しました。

フィルタ抽出VBA

'指定した単語から始まるフォントをリスト化
Function GetFonts(ParamArray FontNameFiltes() As Variant) As Collection
    Set GetFonts = New Collection
    
    With Application.CommandBars("Formatting").Controls(1)
        Dim i As Long
        For i = 1 To .ListCount
            Dim fnf As Variant
            For Each fnf In FontNameFiltes
                If .List(i) Like fnf Then
'                    Debug.Print .List(i)
                    GetFonts.Add .List(i)
                End If
            Next
        Next
    End With
End Function

Sub Test_GetFonts()
    Dim item
    For Each item In GetFonts("游ゴシック*", "YuGothic*", "Yu Gothic*")
        Debug.Print item
    Next
End Sub

これで、

  • 游ゴシック　から始まるフォント
  • YuGothic　から始まるフォント
  • Yu Gothic　から始まるフォント

が抽出できます。


抽象化について

抽象化するに当たってやらなければならないのは

  • 「游ゴシック」等の文字列の変数化
  • ワークブック、ワークシートの変数化
  • ブック全体に対する繰り返し

です。

したがって、各種プロシージャには、ブック・シート・フォント置換リストをパラメータとして渡すことで抽象化しました。

ブック・シートの抽象化とは、即ちActiveWorkbookやActiveSheetの部分です。

VBA不慣れな方の場合はそれすら省略している場合があるので、Cells、Rangeから始まる部分は要注意ですね。

さらに「游フォント」を「MSPフォント」に置換するということで、Dictionaryを使って置換テーブルを作成してから渡すようにしました。

Sub セルの游フォントをMSPフォントに変更()
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        With rng.font
            Select Case .Name
                Case "游ゴシック": .Name = "ＭＳ Ｐゴシック"
                Case "游明朝": .Name = "ＭＳ Ｐ明朝"
            End Select
        End With
    Next
End Sub
'↓'
Sub セルのフォントを変更(ws As Worksheet, fonts As Dictionary)
    Dim rng As Range
    For Each rng In ws.UsedRange
        With rng.font
            Dim fts
            For Each fts In fonts.Keys
                If .Name = fts Then .Name = fonts(fts)
            Next
        End With
    Next
End Sub

Sub Test_セルのフォントを変更()
    Dim fonts As Dictionary: Set fonts = New Dictionary
    Dim item
    For Each item In GetFonts("游ゴシック*", "YuGothic*", "Yu Gothic*")
        If Not fonts.Exists(item) Then
            fonts.Add item, "ＭＳ Ｐゴシック"
        End If
    Next
    Call セルのフォントを変更(ActiveSheet, fonts)
End Sub



参考資料

第一弾　：　本記事を書くための元ネタです。

www.excel-chunchun.com


第二弾　：　游ゴシックがそもそも生まれないようにしようという目的のスクリプトです。

www.excel-chunchun.com


第一弾が以下のサイトにて引用されましたので紹介しておきます。

www.yuru-wota.com


まとめ

ついに、我々の天敵「游ゴシック」「游明朝」を安全かつ迅速に消し去り、行の高さが変化する問題を防ぐことができるようになりました。

本記事の操作を全て手動でやるとなると結構時間がかかるので、大幅に作業効率がアップすると思います。（もっと早く作れば良かった・・・。）

このマクロは「新しいエクセル(游ゴシック)で作ったブック」と「古いエクセル（MS Pゴシック）で作ったブック」の間で、コピーしたりシートを移動した場合に必須です。

万全を期したつもりですが、もし駆除しきれていない箇所があれば是非教えてください！

全力で対応する所存です。

世界(Excel)から游ゴシックを無くして、平和に過ごしましょう♪

以上


世界から游フォントを消し去るマクロのダウンロード

以上のプログラムを合成して、游ゴシック体を駆逐するためのマクロをGitHubにて公開しました。

GitHubダウンロード

GitHubリポジトリを閲覧

結果

f:id:Kotori-ChunChun:20190720233829g:plain

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)