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

以前、游ゴシック体を駆逐する方法を紹介しましたが、あの面倒な設定全てをvbsで自動化することに成功したので紹介します。

---

はじめに

游ゴシック体反対派の皆さん、お久しぶりです。

今回は、以前紹介した「Excelから游ゴシック体を徹底的に駆逐する方法」の第二回目になります。

手作業で安全に游ゴシック体を消したい方は下記の記事を御覧ください。

www.excel-chunchun.com

この記事は意外と検索からの流入もが多く、比較的人気記事となっております。

やっぱりみんな「游ゴシック体」嫌いなんですかね？

このスクリプトを使えば全社導入も容易です！

思い切って会社全体の游ゴシック体を駆逐しましょう！（笑）

前回の記事で記載したとおり、Excelから游ゴシック体を完全に消し去るには設定項目が沢山あり、新しい環境を作る度に設定するのが結構面倒です。

そんな私が、ワンタッチで游ゴシック体を駆逐できるステキなスクリプトをついに完成させました！

もちろん、ワンタッチで元に戻す事もできますのでご安心ください。

変更内容

Part1からの変更内容は以下のとおりです。

• スクリプトの実行頻度を増加
• インストール／アンインストールの簡素化
• 一瞬コマンドプロンプトが表示される問題を解消

スクリプトの実行頻度を増加

以前の記事に書いたスクリプトでは、/onlogonつまり、PCの電源を入れる度に忌々しいアップデートからリカバリーしてくれています。

ところが、当然といえば当然、アップデートは電源を入っているときに行われるため、たまに游ゴシック体で立ち上がるときがあります。

仕方ないので游ゴシック体が出現した時は、泣く泣くExcelを閉じてスクリプトを直接実行・・・しているのですが、それはそれで面倒です。

まずはそれを改善したい。

というわけで・・・1分毎に更新するようにしてみました。

タスクの実行のタイミングを1分毎に設定する時は、/sc minute /mo 1と書くようです。

schtasks /create /tn "MyTask" /tr "hogehoge.vbs" /sc minute /mo 1

インストール／アンインストールの簡素化

そもそも游ゴシック体を駆逐するには、初期設定として多数の設定変更が必要で、新しい環境に組み込むのが面倒です。

できれば全ての設定をワンクリックで行いたい。

さらに実行頻度を上げたことで、游ゴシック体の取り消しが困難になったので、アンインストールもしたい。

というわけで、インストール／アンインストール用のvbsを書いてみました。（コード全文は後ほど）

アンインストール処理のイメージは、ざっとこんなところです。

• タスクスケジューラからの削除

wsh.exec "schtasks /delete /tn """ & APP_NAME & """ /F"

• 書き換えたレジストリの削除

wsh.RegDelete "HKCR\.xls\ShellNew\FileName"

• データファイルの削除
• テンプレートファイルの削除
• 新規作成ファイルの削除

fso.DeleteFile "C:\Program Files\Microsoft Office\root\VFS\Windows\SHELLNEW\EXCEL12.XLSX"

一瞬コマンドプロンプトが表示されるのを解消

Windowsには、vbsを実行するためのプログラムが2種類組み込まれています。

	cscript	wscript
利用想定環境	コンソール向け	対話向け
メッセージボックス	無視	ユーザーの応答待ち
コマンドプロンプト	一瞬表示される	表示されない

なぜか前記事のスクリプトはcscriptを使っていたため、wscriptに変更しました。

ちなみに、vbsをダブルクリック実行したときに黒い画面が見える場合は、vbsの関連付けがcscriptになっていることを示しています。

コマンドプロンプトで、cscript //h:wscriptと実行すれば関連付けが切り替わるそうです。

しかしwscriptに変更することで一つだけ問題があります。

上記の表の通りメッセージボックスの挙動が変わるらしいのです。

スクリプトの末尾には以下のようなコードが有りました。

MsgBox "完了",, "Excel フォント自動変更"

従って、以前のコードでは無視されていたのですが、このメッセージが表示されてしまうようになりました。

実行頻度を1分毎に変えたため、このままでは以下のメッセージボックスが1分ごとに出てきます。笑えませんね。

---------------------------
Excel フォント自動変更
---------------------------
完了
---------------------------
OK   
---------------------------

というわけで、Excel_FontChange.vbsの実行時パラメータに/hideを追加して、

• ダブルクリック時は「完了」を表示
• タスクスケジューラからの起動時は何も表示しない

という動きになるように調整しました。

wsh.exec "schtasks /create /tn " & APP_NAME & " /tr ""wscript \""" & VBS_PATH & "\"" \""/hide\"""" /sc minute /mo 1 /rl highest /F"

このダブルクォーテーションの数の調整にとても苦労しました。

コマンドプロンプトで通常のexeを1分毎に管理者として実行するタスクを登録する時はこうです。

schtasks /create /tn タスク名 /tr hoge.exe /sc minute /mo 1 /rl highest /F

しかし実行ファイルのパスに半角スペースが含まれる場合は、ダブルクォーテーションで囲う必要があり"文字列"`とします。

schtasks /create /tn タスク名 /tr "C:\Program Files\fuga\hoge.exe" /sc minute /mo 1 /rl highest /F

登録したexeに実行時パラメータ/hideを渡す場合は`"実行プログラム(半角スペース)パラメータ"とします。

schtasks /create /tn タスク名 /tr "C:\Program Files\fuga\hoge.exe /hide" /sc minute /mo 1 /rl highest /F

ところが、実行時パラメータにパスを渡すとなると、そこに半角スペースを含んでいる事があるため、ココでさらにダブルクォーテーションで囲う措置が必要になります。

しかし、この場合はエスケープする必要があるそうで、\"文字列\"とするそうです。

/hideのように半角スペースを含まないのであれば下記のように空欄でもOKです。

schtasks /create /tn タスク名 /tr "C:\Program Files\fuga\hoge.exe \"C:\Program Files\hoge\fuga.vbs\" /hide" /sc minute /mo 1 /rl highest /F

ここまでコマンドプロンプト（bat）の場合でしたが、vbsにするとschtasksが実行プログラムになるので、更に全体をダブルクォーテーションで囲わなければなりません。

vbsにおけるエスケープ文字はダブルクォーテーションは""（ダブルクォーテーション２つ）なので、そのように修正するとこうなります。

wsh.exec "schtasks /create /tn タスク名 /tr ""C:\Program Files\fuga\hoge.exe \"C:\Program Files\hoge\fuga.vbs\" /hide"" /sc minute /mo 1 /rl highest /F"

こうして、最初に記載したようなコードが生まれました。

スクリプト

管理者権限に昇格

スクリプトを管理者権限で実行されるように、自分自身を昇格して再実行させるためのスクリプトです。

タスクスケジューラに登録した時点で、管理者権限で実行するように登録するため本来は必要ないのですが、vbsをダブルクリックして直接起動したいときがあるので、基本的にvbsには入れるようにしています。

プロシージャCheckAdmin()に押し込んでいるのは、一見無意味に見えますが、変数のスコープを制限して、後々のスクリプトと競合を起こさないための工夫になります。

vbsについて深く勉強したことがないため、これが一般的な手法なのかどうかは知りません。

▶ソースコードを展開

' 管理者権限確認
Sub CheckAdmin()

    Dim Args
    Dim UacFlag  '管理者権限フラグ（パラメータにuacを含む時True）
    Set Args = WScript.Arguments

    dim i
    For i = 0 To Args.Count - 1
      if Args(i) = "uac" then UacFlag = true
    Next

   ' 管理者権限に昇格
   'Dim WScript    'VBEでのコードチェック用
    Dim Param
    Do While UacFlag = false And WScript.Version >= 5.7

      '現在のパラメータをスペース区切りに変換
      Param = ""
      For i = 0 To Args.Count - 1
        Param = Param & " " & Args(i)
      Next
      
      ' Check WScript5.7~ and Vista~
      Dim os, wmi, Value
      Set wmi = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
      Set os = wmi.ExecQuery("SELECT *FROM Win32_OperatingSystem")
      For Each Value In os
        If Left(Value.Version, 3) < 6.0 Then Exit Do   'Exit if not vista
      Next
       
      ' Run this script as admin.
      Dim sha
      Set sha = CreateObject("Shell.Application")
      sha.ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """ uac" & Param, "", "runas"
       
      WScript.Quit
    Loop

End Sub

Call CheckAdmin

インストールされたExcelのパスの確認

EXCEL.EXEが所定の場所にあるかどうかで、インストールされているExcelが32bit版か64bit版かを判定し、テンプレートフォルダなどが変化します。

今後のアップデートなどでパスが変わると、下記の2箇所を変更しないといけないかもしれません。

本ツールのインストール先は、OSのビット数やOfficeのバージョンに関係なくC:\Program Files\Excel_FontChange\固定です。

例えば2016から増えているUWP版には対応していません。

▶ソースコードを展開

'初期設定

Dim fso
Dim wsh

Dim gScriptName
Dim gScriptFullName
Dim gScriptPath
Dim PATH_TEMPLATE
Dim PATH_NEW

Const APP_NAME = "Excel_FontChange"
Const APP_PATH = "C:\Program Files\Excel_FontChange\"
Const VBS_PATH = "C:\Program Files\Excel_FontChange\Excel_FontChange.vbs"

Const FILE_XLTX = "Book.xltx"

Sub VBA_Main()
    Dim PGF

'#If VBA7 Then
'#Else
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set wsh = CreateObject("WScript.Shell")
    
    gScriptName = WScript.ScriptName
    gScriptFullName = WScript.ScriptFullName
    gScriptPath = fso.GetParentFolderName(gScriptFullName) & "\"
'#End If

   Rem Excel.EXEの存在からProgramFilesのパスを特定
    If fso.FileExists("C:\Program Files (x86)\Microsoft Office\root\Office16\EXCEL.EXE") Then
        PGF = "Program Files (x86)"
    ElseIf fso.FileExists("C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE") Then
        PGF = "Program Files"
    Else
        MsgBox "対応しているバージョンのExcelがインストールされていません。"
        Exit Sub
    End If

   Rem テンプレートファイル保存パス
    PATH_TEMPLATE = "C:\" & PGF & "\Microsoft Office\root\Office16\XLSTART\"
   Rem 新規作成のファイル保存パス
    PATH_NEW = "C:\" & PGF & "\Microsoft Office\root\VFS\Windows\SHELLNEW\"

End Sub

Call VBA_Main

Excel_FontChange.vbsの本体

タスクスケジューラから呼ばれるスクリプトに関しては、次のように改変しました。

• 管理者権限に昇格
• インストールされたExcelのパスの確認
• "EXCEL8.XLS", "EXCEL12.XLSM", "EXCEL12.XLSX"の更新

▶ソースコードを展開

' todo:

Dim CurPath
CurPath = gScriptPath

'テンプレートをコピー
Dim XlStartPath
XlStartPath = PATH_TEMPLATE

fso.CopyFile gScriptPath & FILE_XLTX, XlStartPath & FILE_XLTX, True

'新規作成フォルダにコピー
Dim ShellNewPath
ShellNewPath = PATH_NEW

Dim NewFiles
NewFiles = Array("EXCEL8.XLS", "EXCEL12.XLSM", "EXCEL12.XLSX")

Dim file
For Each file In NewFiles
    fso.CopyFile CurPath & file, ShellNewPath & file, True
Next

'後処理
Dim i
Dim IsHide
Dim Args

Set Args = WScript.Arguments
For i = 0 To Args.Count - 1
    If Args(i) = "/hide" Then IsHide = True
Next

If IsHide = False Then
    MsgBox "完了",, "Excel フォント自動変更"
End If

Excel_FontChange_Install.vbsの本体

自動インストールを行うスクリプトに関しては、次のような構成です。

• 管理者権限に昇格

• インストールされたExcelのパスの確認

• インストール／アンインストールを選択

• インストールの場合

  • Excelのオプションのフォント変更

  vb wsh.RegWrite "HKCU\Software\Microsoft\Office\16.0\Excel\Options\Font", "ＭＳ Ｐゴシック,11", "REG_SZ"

  • テンプレート／新規作成のファイル事前準備

  vb fso.CopyFolder gScriptPath & APP_NAME, Left(APP_PATH, Len(APP_PATH) - 1), True

  • 1分おきに実行するタスクスケジューラ登録

  vb wsh.exec "schtasks /create /tn " & APP_NAME & " /tr ""wscript \""" & VBS_PATH & "\"" \""/hide\"""" /sc minute /mo 1 /rl highest /F"

  • 直ちにフォント書き換えを実行

  vb wsh.exec "schtasks /run /tn " & APP_NAME & ""

  • xlsxの新規作成のテンプレート(EXCEL12.XLSX)をバックアップ

  vb fso.CopyFile PATH_NEW & "EXCEL12.XLSX", PATH_NEW & "EXCEL12_base.XLSX"

  • 新規作成レジストリの登録

  vb wsh.RegWrite "HKCR\.xls\ShellNew\FileName", PATH_NEW & "EXCEL8.XLS", "REG_SZ"

• アンインストールの場合

  • タスクスケジューラからの削除

  vb wsh.exec "schtasks /delete /tn """ & APP_NAME & """ /F"

  • 書き換えたレジストリの削除

  vb wsh.RegDelete "HKCR\.xls\ShellNew\FileName"

  • データファイルの削除
  • テンプレートファイルの削除
  • 新規作成ファイルの削除

  vb fso.DeleteFile "C:\Program Files\Microsoft Office\root\VFS\Windows\SHELLNEW\EXCEL12.XLSX"

微妙に苦労したのが、新規作成に*.xlsを追加する方法で、従来(Excel 2007,2010)の頃は"HKCR.xls\ShellNew\FileName"に追加するだけで良かったのですが、Excel 2016やOffice365ではココに書き込んだだけでは増えません。

試行錯誤した結果、"HKCU\Software\Classes\xls_auto_file"にファイルの種類を書き込むことで、新規作成が有効になることがわかりました。

ちなみにこの部分が新規作成メニューの名称になっているようです。

きっと空欄だとメニュー表示出来ないってことなんでしょうね。

wsh.RegWrite "HKCR\.xls\ShellNew\FileName", PATH_NEW & "EXCEL8.XLS", "REG_SZ"

Rem [ファイルの種類]の定義。ココが空欄だとShellNewに登録してもメニューに増えない。
wsh.RegWrite "HKCU\Software\Classes\xls_auto_file", "Microsoft Excel 97-2003 互換ブック", "REG_SZ"
Rem 既定値は\で終了
wsh.RegWrite "HKCR\xls_auto_file\", "Microsoft Excel 97-2003 互換ブック", "REG_SZ"

▶ソースコードを展開

' todo:

Select Case MsgBox(" はい ：インストール" & vbLf & "いいえ：アンインストール", vbYesNoCancel, "Excel 游ゴシック削除ツール")
    Case vbYes : Call Install
    Case vbNo  : Call UnInstall
    Case Else  :  MsgBox "キャンセルされました。"
End Select

Sub Install()

'#If VBA7 Then
    Call VBA_Main
'#End If

   Rem Excelのオプションのフォント変更
    wsh.RegWrite "HKCU\Software\Microsoft\Office\16.0\Excel\Options\Font", "ＭＳ Ｐゴシック,11", "REG_SZ"

   Rem テンプレート／新規作成のファイル事前準備
    fso.CopyFolder gScriptPath & APP_NAME, Left(APP_PATH, Len(APP_PATH) - 1), True

   Rem 1分おきに実行する方法
    wsh.exec "schtasks /create /tn " & APP_NAME & " /tr ""wscript \""" & VBS_PATH & "\"" \""/hide\"""" /sc minute /mo 1 /rl highest /F"
    
   Rem とりあえず今すぐ1回実行しておく
   Rem 作成直後は実行されないらしいので遅延させる。
    WScript.Sleep 1000
    wsh.exec "schtasks /run /tn " & APP_NAME & ""
    
   Rem 新規作成のバックアップ
    If fso.FileExists(PATH_NEW & "EXCEL12.XLSX") Then
        If Not fso.FileExists(PATH_NEW & "EXCEL12_base.XLSX") Then
            fso.CopyFile PATH_NEW & "EXCEL12.XLSX", PATH_NEW & "EXCEL12_base.XLSX"
        End If
    End If

   Rem 新規作成のレジストリ追加
    wsh.RegWrite "HKCR\.xlsm\Excel.SheetMacroEnabled.12\ShellNew\FileName", PATH_NEW & "EXCEL12.XLSM", "REG_SZ"
   Rem 下記は効果なし。 Excel.Sheet.8はxls_auto_fileの定義がないからだと思われる
   Rem REG ADD "HKEY_CLASSES_ROOT\.xls\Excel.Sheet.8\ShellNew" /v "FileName" /t REG_SZ /d "C:\Program Files (x86)\Microsoft Office\Root\VFS\Windows\ShellNew\EXCEL8.XLS" /f
    wsh.RegWrite "HKCR\.xls\ShellNew\FileName", PATH_NEW & "EXCEL8.XLS", "REG_SZ"
   Rem [ファイルの種類]の定義。ココが空欄だとShellNewに登録してもメニューに増えない。
    wsh.RegWrite "HKCU\Software\Classes\xls_auto_file", "Microsoft Excel 97-2003 互換ブック", "REG_SZ"
   Rem 既定値は\で終了
    wsh.RegWrite "HKCR\xls_auto_file\", "Microsoft Excel 97-2003 互換ブック", "REG_SZ"

    MsgBox "完了", vbOKOnly, "インストール"
    
End Sub

Sub Uninstall()

'#If VBA7 Then
    Call VBA_Main
'#End If
    If fso.FolderExists(APP_PATH) Then
        fso.DeleteFolder Left(APP_PATH, Len(APP_PATH) - 1)
    End If

    wsh.exec "schtasks /delete /tn """ & APP_NAME & """ /F"

   Rem Excelのオプションの変更
    wsh.RegWrite "HKCU\Software\Microsoft\Office\16.0\Excel\Options\Font", "游ゴシック,11", "REG_SZ"

   Rem テンプレート「Book.xltx」の削除
    If fso.FileExists(PATH_TEMPLATE & FILE_XLTX) Then
        fso.DeleteFile PATH_TEMPLATE & FILE_XLTX
    End If

   Rem 新規作成のファイル削除
    If fso.FolderExists(PATH_NEW) Then
        On Error Resume Next
        fso.DeleteFile PATH_NEW & "EXCEL8.XLS"
        fso.DeleteFile PATH_NEW & "EXCEL12.XLSM"
        fso.DeleteFile PATH_NEW & "EXCEL12.XLSX"
        Rem fso.CopyFile PATH_NEW & "EXCEL12_base.XLSX", PATH_NEW & "EXCEL12.XLSX", True
        fso.MoveFile PATH_NEW & "EXCEL12_base.XLSX", PATH_NEW & "EXCEL12.XLSX"
        On Error GoTo 0
    End If
    
    Rem 新規作成のレジストリ削除
    On Error Resume Next
    wsh.RegDelete "HKCR\.xlsm\Excel.SheetMacroEnabled.12\ShellNew\FileName"
    Rem Excel.Sheet.8は不要なはずだが一応
    wsh.RegDelete "HKCR\.xls\Excel.Sheet.8\ShellNew\FileName"
    wsh.RegDelete "HKCR\.xls\ShellNew\FileName"
    On Error GoTo 0
    
    MsgBox "完了", vbOKOnly, "アンインストール"

End Sub

完成品データ一式ダウンロード

ダウンロード

游ゴシック体を駆逐するためのスクリプト・テンプレート一式を詰め込んだZIPを、GitHubにて公開しました。

GitHubダウンロード

GitHubリポジトリを閲覧

注意

Officeのインストール方法によっては動作しません。

昨今はWindows10にUWP版がプリインストールされていることが多いので、知らずにUWP版を使っている人が増えていますが、UWP版では制約があり動作しません。

問題が起きた人はMicrosoftのOffice削除ツールなどで完全消去してから、公式のオンラインダウンロードにてデスクトップ版アプリを入れ直すようにすることを推奨します。

情シスの方はデスクトップアプリ版に入れ替えてから出荷してあげると良いかと思います。

まとめ

とりあえず、これでシツコイ游ゴシック体から、Excelを守る術を手に入れました！

もっともっとExcelを快適に使えるようにしていきましょう♪

以上

2019/7/21 続編を執筆しました。

www.excel-chunchun.com

---

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

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