Excelの別名保存したブックを開くとフォントが游ゴシックに変わる

2021-06-26

Office 2013から Office 2016にバージョンがあがったとき、標準フォントが「MS Pゴシック」から「游ゴシック」に変更になりました。

フォント

Office 2016 が発売されたのは、2016年9月で5年経つところですが、今でも古いバージョンのofficeを使用している企業があります。そしてフォントのことで問題になることがまだ稀にあります。

Office2016以降のフォント

エクセルの設定を変更していない場合は、新しいブックを開くと「游ゴシック」で開きます。

[ファイル] ＞ [オプション] ＞ [全般] ＞ [新しいブックの作成時] で「次を規定フォントで使用」を「本文のフォント」にしている場合は「游ゴシック」で開きます。

Office2013で作成し2016で開いたらフォントが変わる

シートのコピーを新しいブックで開く操作をしたときに起こった問題です。自宅のPCには2013がすでにないため、再現できませんでした。

フォントが変わった例

エクセルブックにテンプレートになるシートを用意し、そのシートにデータを書き出した後、別名保存するというマクロでした。

テンプレート用のシートのフォントは「MSPゴシックでした。

途中の処理を省き、別名保存だけのコードです。

Sub sample1()
Dim fPath As String: fPath = "F:\sample\"
Dim ws As Worksheet: Set ws = Worksheets("sample")

    ws.Copy

    With ActiveWorkbook
        .SaveAs Filename:=fPath & "sample2.xlsx"
        .Close
    End With

End Sub

手動操作の場合

作成した office2013 やoffice2019で保存されたブックを開くと、「MS Pゴシック」ですが、offce2016で開くと「游ゴシック」でした。

office2019でも「游ゴシック」で保存される場合

office2019で保存されたブックを開くと「游ゴシック」で保存される場合の例です。

保存されたブック

以下の操作の場合は、保存されるブックを開くと「游ゴシック」です。

もとのブックで範囲をコピーする
新しいブックを開き、データを貼り付ける

罫線等の設定は省いたコードです。

Sub sample2()

    Dim fPath As String: fPath = "F:\sample\"
    Dim ws As Worksheet: Set ws = Worksheets("sample")
    
    ws.UsedRange.Copy
    
    Dim wbNew As Workbook: Set wbNew = Workbooks.Add
    Selection.PasteSpecial Paste:=xlValues
    
    With wbNew
        ActiveSheet.Range("A1").Select
        .SaveAs Filename:=fPath & "sample2.xlsx"
        .Close
    End With
End Sub

オプションの設定変更で「游ゴシック」で保存しない方法

この方法の場合でも、オプション設定を変更すれば「游ゴシック」で保存されなくなります。

[ファイル] ＞ [オプション] ＞ [全般] ＞ [新しいブックの作成時] で「次を規定フォントで使用」を変更します。

オプション設定後に「sample2」を実行して保存されたブックを開くと設定したフォントで保存されています。

これでも問題は残り、行の高さが狭いため文字が読みにくいです。

行の高さの設定も追加する必要があります。

オプションの設定は変えずに「游ゴシック」で保存しない方法

データを貼り付けた後にフォントの設定と行の高さを変える方法です。

11行目「with wbNew」以降に追記します。

フォントをMSPゴシックにする
行の高さを18にする

Sub sample3()

    Dim fPath As String: fPath = "F:\sample\"
    Dim ws As Worksheet: Set ws = Worksheets("sample")
    
    ws.UsedRange.Copy
    
    Dim wbNew As Workbook: Set wbNew = Workbooks.Add
    Selection.PasteSpecial Paste:=xlValues
    
    With wbNew
        ActiveSheet.Cells.Select
        Selection.Font.Name = "ＭＳ Ｐゴシック"
        Selection.RowHeight = 18
        ActiveSheet.Range("A1").Select
        .SaveAs Filename:=fPath & "sample2.xlsx"
        .Close
    End With
End Sub