新規ブックでのCtrl+Sを旧ダイアログに戻すマクロ

新規ブックや読取専用ブックでCtrl+S時に出る「名前を付けて保存ダイアログ」を、
旧来のダイアログに戻すマクロを紹介します。

実装経緯と仕様

いつごろからか「名前を付けて保存」ダイアログが改悪されました。

OneDriveを推したいMicrosoftさんの気持ちはわかるんですが、
フォルダパスをペーストできる場所がないのは許せませんね（#^ω^）

といってもこちらのダイアログは回避可能で、
「F12：名前を付けて保存」を使えば従来のダイアログで新規保存ができます。

なのでF12に慣れてしまえばこちらは困らないのですが、
もうひとつ、個人的にどうしても困るダイアログがあります。

それがこの「新規ブックや読取専用ブックでCtrl+S」をしたときに出る、

この「名前を付けて保存」ダイアログ2です。

こいつはほんとにひどいやつで、

1. フォルダパスの入力欄がない
2. フォルダパスの入力欄があるダイアログに移動できない(さっきよりひどい)
3. 初期フォルダが「今のフォルダ」ではなくOneDrive

という三重苦を浴びてしまうため、
残念ながら「一旦キャンセルしてF12」しか解決策がありません。

個人的には特に「3」が致命的で、共有サーバー上のファイルを読取で開いた際、
「元ファイル - コピー」で同一フォルダに保存できないのが面倒すぎます。

またこれはそんなにメジャーじゃないかもしれませんが、
私は新規ブックの初回保存も「Ctrl+S」でやっている派だったため、
これができなくなるのも勘弁してほしかったですね。

ということで前置きが長くなりましたが、
この解決策のひとつとして「Ctrl+Sを自作マクロで上書きする」方法があります。

使用する場合は個人用マクロブックなどにこのマクロを搭載し、
マクロのショートカットキーを「Ctrl+S」にしてください。

ソースコード

' Ctrlを離すまで待機
Declare PtrSafe Function GetKeyState Lib "User32" (ByVal vKey As Integer) As Integer
Function Ctrlキーが離されるまで待機する()
    Do While GetKeyState(17) < 0
        DoEvents
    Loop
End Function

' Ctrl+Sを上書きする用のマクロ
Sub CtrlS_上書不可時旧ダイアログ版()

    Dim wb保存ブック As Workbook
    Set wb保存ブック = ActiveWorkbook
    
    ' 読取専用でなく、かつ保存済み(パスが存在)のファイルは通常の上書保存
    If wb保存ブック.ReadOnly = False _
    And wb保存ブック.Path <> "" Then
        wb保存ブック.Save
    
    ' そうでなければ名前を付けて保存ダイアログを表示
    Else
        Call Ctrlキーが離されるまで待機する
        SendKeys "{F12}"
    End If

End Sub

解説

メインマクロ自体はとてもシンプルなコードです。

ActiveWorkbookが読取専用または新規ブックか判定し、

• 通常のブックであれば「.Save」で上書き保存、
• 読取専用または新規ブックなら「F12」キーを送信

という処理を実行しているだけのコードです。

このコードで済むなら簡単だったのですが、実はこれではうまく動きません。

これだとCtrl+S押下時のCtrl押下判定が残ってしまうため、
SendKeys "{F12}"　が「Ctrl+F12：ファイルを開く」になってしまいます。

これを回避するには「Ctrlキーを離すまでマクロの実行を止める」コードが必要で、
それをFunctionプロシージャで実装して対応しています。
（Functionにしたのは「マクロの一覧」に表示しないためです）

GetKeyStateの解説は長くなるのでここでは割愛します。

上記コードをそのままコピペしても動きますので、
特に調べず使ってしまってOKです。