Excel で、開いただけで閉じようとすると保存確認【VBA で原因を見つける】

結論

　以下のいずれかが原因です。

1. どこかのセルに揮発性関数を使用している。
2. どこかに「リンク図」がある。

　...でも「どこ」に？

アイドルマスター シンデレラガールズ 佐々木 千枝 ハイファイ デイズ 1/7スケール PVC製 塗装済み完成品 フィギュア

はじめに

　Excel ファイルを開いて、なにも編集行為をしていないにも拘わらず、そのまま閉じようとすると保存するかどうか尋ねるダイアログが表示される場合があります。

　心当たりがなければそのまま閉じてしまえば良いのですが、あまりに頻繁だと煩わしい。できれば解決しておきたい。

　それらしきキーワードでネットを検索すると、上記の結論に記したような原因はすぐに見つかります。しかし分かりづらい書き方だったりしたので、自分でも書いておきます。

知りたいのはそこじゃない

　それに本当に知りたいのは、問題のセルや図形が一体どこにあるのかです。

　作ってすぐの小さなファイルだったら、どこに原因があるのか把握しているでしょう。しかし長い時間かけて作った肥大化したファイルだったら？揮発性関数を一つ一つ検索しますか？図形を一つ一つ選択して、どれがリンク図か確かめる？

　これを解決してくれそうなサイトは見つかりませんでした。

無いので作った

　しかたがないので自分でマクロを作りました。

　次のソースの「開いただけで保存確認するのはなぜなのだ()」プロシージャを実行していただければ、該当のセルや図形とそれらの位置を教えてくれます。

　mac、Windows 両対応です。

ソースコード

Option Explicit

'
Public Sub 開いただけで保存確認するのはなぜなのだ()
    Dim isContinue As Boolean
    
    isContinue = 隠しシートを含めて数式セルを確認
    If Not isContinue Then Exit Sub
    
    リンクした図を確認
    
    MsgBox "検索を終了しました。"
End Sub

' 数式セルに揮発性関数が含まれていないかを確認する
Private Function 隠しシートを含めて数式セルを確認() As Boolean
    Dim s As Long
    Dim r As Long
    Dim c As Long
    Dim ws As Worksheet
    Dim tmpFormula As String
    Dim checkMsg As String
    Dim msg As String
    Dim msgResult As Long
    msg = ""
    
    For s = 1 To ActiveWorkbook.Sheets.Count
        Set ws = ActiveWorkbook.Sheets(s)
        If TypeName(ws) <> "Worksheet" Then GoTo CONTINUE_SHEET
        
        For r = 1 To ws.Cells.SpecialCells(xlLastCell).Row
            For c = 1 To ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
                tmpFormula = ws.Cells(r, c).Formula
                
                If tmpFormula <> "" And Left(tmpFormula, 1) = "=" Then
                    checkMsg = 揮発性関数があればメッセージ(tmpFormula)
                    If checkMsg = "" Then GoTo CONTINUE_COLUMN
                    
                    If Not ws.Visible Then
                        msg = msg & "非表示の"
                    End If
                    
                    msg = msg & "シート '" & ws.Name & "' の"
                    msg = msg & "セル '" & ws.Cells(r, c).Address & "' に"
                    msg = msg & checkMsg & vbCrLf & vbCrLf
                    msg = msg & "検索を続けますか？"
                    msgResult = MsgBox(msg, vbYesNo + vbQuestion)
                    If msgResult = vbNo Then GoTo ABORT_SEARCH_CELL
                    msg = ""
                End If
                
CONTINUE_COLUMN:
            Next c
            
CONTINUE_ROW:
        Next r
    
CONTINUE_SHEET:
    Next s
    
EXIT_SEARCH:
    隠しシートを含めて数式セルを確認 = True
    Exit Function
    
ABORT_SEARCH_CELL:
    隠しシートを含めて数式セルを確認 = False
End Function

' 式の中に揮発性関数が含まれていたらメッセージを返す。
' 揮発性関数はわかっているものだけを取りあげているので、Excel のバージョンアップで増えたら追加が必要。
Public Function 揮発性関数があればメッセージ(ByVal fm As String) As String
    Dim ret As String
    Dim funcs As Variant
    Dim i As Integer
    
    funcs = Array("NOW", "TODAY", "RAND", "CELL", "INDIRECT", "OFFSET", "INFO", "SUMIF", "RADBETWEEN")
    ret = ""
    fm = UCase(fm)
    
    For i = LBound(funcs) To UBound(funcs)
        If InStr(fm, funcs(i) & "(") > 0 Then
            ret = funcs(i) & " 関数があります。"
        End If
    Next i
    揮発性関数があればメッセージ = ret
End Function

' リンクした図がないかどうかを確認する
Private Sub リンクした図を確認()
    Dim s As Long
    Dim z As Long
    Dim ws As Worksheet
    Dim sp As Variant
    Dim msg As String
    Dim msgResult As Long
    msg = ""
    
    On Error Resume Next
    
    For s = 1 To ActiveWorkbook.Sheets.Count
        Set ws = ActiveWorkbook.Sheets(s)
        For z = 1 To ws.Shapes.Count
            If sp.Type = msoPicture Then
                ws.Activate
                sp.Select
                If Selection.Formula <> "" Then
                    If Not ws.Visible Then
                        msg = msg & "非表示の"
                    End If
                    msg = msg & "シート '" & ws.Name & "' にリンクした図があります。" & vbCrLf
                    msg = msg & GetCellAddressFrom(ws, Selection.Left, Selection.Top) & " あたりです。"
                    msg = msg & vbCrLf & vbCrLf
                    msg = msg & "検索を続けますか？"
                    msgResult = MsgBox(msg, vbYesNo + vbQuestion)
                    If msgResult = vbNo Then GoTo EXIT_SEARCH
                    msg = ""
                End If
            End If
        Next z
    Next s
    
EXIT_SEARCH:
    On Error GoTo 0
End Sub

' 座標（例えば図形の位置）から、付近のセルアドレスを取得する
Public Function GetCellAddressFrom(ByRef ws As Worksheet, ByVal X As Double, ByVal Y As Double) As String
    Dim r As Long
    Dim c As Long
    
    c = -1
    For c = 1 To ws.Columns.Count
        If ws.Columns(c).Left + ws.Columns(c).Width > X Then Exit For
    Next c
    
    r = -1
    For r = 1 To ws.Rows.Count
        If ws.Rows(r).Top + ws.Rows(r).Height > Y Then Exit For
    Next r
    
    If c <= 0 Or r <= 0 Then
        GetCellAddressFrom = "A1"
        Exit Function
    End If
    
    GetCellAddressFrom = ws.Cells(r, c).Address
End Function