サポンテ 勉強ノート

サポンテの勉強ノート・読書メモなどを晒します。

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

結論

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

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

 ...でも「どこ」に?

はじめに

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

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

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

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

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

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

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

無いので作った

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

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

 macWindows 両対応です。

ソースコード

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

図形を含めた最下の行番号を取得する【Excel/VBA/最終行】

はじめに

 Excel VBA で、最も下の行が知りたいという要件はしばしばあります。

 取得する方法は、複数あります

 それぞれ一長一短がありますが、多くの人は自分の作っているワークシートの状況に応じて好みのものを使っていると思います。

続きを読む

針金式除草機 【Wire Weeder】 水稲に

発端

 バイオダイナミック農法の勉強をしていますが、Youtube で海外の農業・園芸関連の動画を見ていると、たまに、見知らぬ道具を使っている人がいます。

 これとか。

 名前も用途もわからなかったのですが、なんとなくそれらしいキーワードで調べたら Wire Weeder と言うらしい。直訳すると「針金の除草機」でしょうか。

wire weeder」で検索

 「wire weeder」で検索してみました。見ての通りかんたんな構造だから、自作している人もチラホラ見かけます。

日本にある似た道具

 日本にある道具で、同じ用法の道具というと「鋤簾じょれん」でしょうか。比較するとずっとゴッツいですが。

 日本に同じような道具を見かけないのは、やっぱり土質でしょうか。動画のようにサラサラな土でなければ、あのような道具ではいかにも頼りなさそうです。

水稲には使えるのではないか

 しかしながら水稲をやっていた経験からは「水の中ならワンチャンあるかも」と感じます。

 除草剤を使用しない水稲栽培では、重厚長大な除草機を使うか、デッキブラシによる除草法があります。サポンテもデッキブラシ除草をやった経験がありますが、ブラシの目にすぐ雑草が詰まってしまうのです。この方法はちょっと実用的でないなと思いました。

 上の動画にあった、弦鋸のブレードを使った Wire Weeder なら水田の底で使うのに結構効果的であるように感じました。泥の中なら多少頼りない道具でも食い込みますし、水草は結構柔らかいので弦鋸のブレードなら簡単に切れるでしょう。

 サポンテは現在、水稲栽培をしていないのですが、また機会があれば試してみたいです。

コピー元の領域を取得する【Excel/VBA】【裏技編】

はじめに

 Excel でコピーや切り取りカットをしたときに、そのコピー元になる範囲を VBA で取得したいケースが出ました。

 すでになにかソリューションがないか、ネットで検索してみます。

VBA コピーされたセル範囲を取得する方法 - Excel | ホームページ制作のサカエン Developer's Blog

 ありました。

Worksheet_SelectionChange イベントと API を利用する必要があります。

 めんどいw

 API 使用すると macOS で使えないんですよ。あとワークシートイベントを使うと、アドイン化するときにまた手間なんですよ。

 それに、自分のプロジェクトに組み込みたいスニペットはもっと短くしてほしいんですよ。できれば 30 行程度の関数やクラス一つで。

 Office クリップボードVBA で取得する方法はないでしょうか。

Office クリップボードをマクロで操作する(MSAA) | 初心者備忘録

 ありました。

以前書いたコードは、OfficeやOSのバージョンが変わると動作しませんでしたが、今回はバージョンの差異も一応考慮しています(Excel 2007,2010,2016で確認)。

 これも API 使うんですね。

結局作った

 こういうときはアレですよ、裏技。裏技で良いんですよ、裏技で。

 以下の条件で作りました。

  • API を使用しない
  • 関数ひとつ
  • Range を返す(返せないときは Nothing

使い方

 セル範囲を選択して、コピーまたはカットをします。

 この状態で関数を実行すると、コピー元の範囲の Range オブジェクトを返します。選択された状態の範囲がなければ Nothing を返します。

ソースコード

Option Explicit

Function GetCutCopyRange() As Range
    ' カット・コピー状態でなければ Nothing を返す
    Set GetCutCopyRange = Nothing
    If Application.CutCopyMode <= 0 Then Exit Function
    
    ' 現在の状態を保持する
    Dim savedCondition As Boolean
    savedCondition = ActiveWorkbook.Saved
    
    On Error GoTo ERROR_EXIT
    ' 表示更新を一時停止する
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ' リンク図としてペーストする
    Dim dummy As Variant
    Set dummy = ActiveSheet.Pictures.Paste(Link:=True)
    
    ' リンク図からリンク先を取得する(リンク図は不要になるので削除する)
    Dim f As String
    f = dummy.Formula
    dummy.Delete
    
    ' リンク先からアドレス他を取得する
    f = Replace(f, "=", "", 1, 1)
    
    Dim wb As Workbook, ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    
    ' 別のワークブックか
    Dim bracketPos As Long, bracketPos2 As Long
    bracketPos = InStr(f, "[")
    bracketPos2 = InStr(f, "]")
    If bracketPos > 0 Then
        Set wb = Workbooks(Mid(f, bracketPos + 1, bracketPos2 - bracketPos - 1))
        f = Mid(f, bracketPos2 + 1)
    End If
    
    ' 別のワークシートか
    Dim exclamationMarkPos As Long
    exclamationMarkPos = InStr(f, "!")
    If exclamationMarkPos > 0 Then
        Set ws = wb.Sheets(Replace(Mid(f, 1, exclamationMarkPos - 1), "'", ""))
        f = Mid(f, exclamationMarkPos + 1)
    End If
    
    ' Range を取得して返す
    Set GetCutCopyRange = ws.Range(f)
ERROR_EXIT:
    ActiveWorkbook.Saved = savedCondition
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Function

 30 行にはなりませんでした、すみません。

どこが裏技か

 ソースコードを追っていただければわかりますが、コピー範囲を一旦「リンクされた図」にペーストし、リンク先を取得してすぐに消しています。ペーストした図が見えないように、画面更新を一旦停止しています。また、保存済みのワークブックが「編集された状態」にならないように、状態を書き戻しています。

 あまりスマートなやり方とは言えませんが、まあ自分のプロジェクトにはこれで十分です。

Excel マクロ&VBA やさしい教科書 [2021/2019/2016/Microsoft 365対応] (一冊に凝縮)

夏を乗り切るための社畜ハック

はじめに

 サポンテは社畜なのでクールビズの奴隷です。そしてそれは良いことです。

 しかしながら近年は暑さが猛々しくなってきているのでつらい。そんなときに役に立った簡単なライフハックをご紹介します。

やりかた

 最近は、汗を拭いたり洗顔の代わりとなるようなウェットティッシュが薬局に並んでいます。とくに夏になると、店頭に山のように置かれています。

 その中でも、メントール成分を使って冷感を謳うものがあります。以下のようなものですね。サポンテは香料が苦手なので、無香を使っています。

続きを読む

Git の「ステージング」はなんのためにある?【git/add/ステージ】

不思議な手順「ステージング」

 Git には、変更点を記録する「コミット」__他の VCSバージョン管理システム だと「チェックイン」と呼称される場合もあります__の前に「ステージに追加」という不思議な手順があります。

 他の VCS を経験してから Git に入門すると、このひと手間ワンクッションが、まったく不思議なのです。なぜ直接コミットできないのか。この手順が一体なんのためにあるのか、どんな場合に有用なのか。

 Git の入門的な書籍やサイトには、腑に落ちるわかりやすい具体的な説明がなぜか少ない。サポンテがかつて読んだ入門的なテキストにも納得できる説明はありませんでした。

 そのような訳で、わりと長い間の疑問でした。

続きを読む

チェック項⽬2-2 1シートに複数の表が掲載されていないか【Excel/総務省の統一ルール】

< 目次へ

例4

 (これまでの経緯を見ると「例1」でいいのでは?)

続きを読む