[[20230612100203]] 『Workbook_Openで設定されているvbaコードが実行さ』(appletea) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Workbook_Openで設定されているvbaコードが実行されない』(appletea)

Private Sub Workbook_Open()の名前でThisWorkBook内に以下のコードを入れているのですが、Excel起動時にこのvbaが実行されません。

Excelを開いている状態で実行した場合は正常に動作します。

理由が全然わからずいきずまったので解決策を教えてほしいです。

マクロの有効化の確認とフォルダのパスがあっているかも確認済みです。

ランダム変更のコードは標準モジュールに入れています。

コード

Private Sub Workbook_Open()
  Call ランダム変更

    Dim FileSize As Long
    Dim pic As ChartObject
    Dim picNameArray As Variant
    picNameArray = Array("\1.png", "\2.png", "\3.png", "\4.png", "\5.png")
    Dim rngArray As Variant
    rngArray = Array(Range("A1:H18"), Range("J2:P13"), Range("R2:X13"), Range("J15:P26"), Range("R15:X26"))
    Dim saveFolderPath As String
    saveFolderPath = "自分のフォルダ"
    For i = 0 To 4 ' 5回繰り返す
        Dim rng As Range: Set rng = rngArray(i)
        Dim picName As String: picName = picNameArray(i)
        '■セル範囲を画像データでコピーする。
        rng.Select
        Do
            Dim nErr As Long, errCount As Long
            DoEvents
            Application.Wait (Now + TimeValue("0:00:01")) ' 1秒待機
            On Error Resume Next
            rng.CopyPicture
            nErr = Err.Number
            On Error GoTo 0
            If nErr = 0 Then Exit Do
            errCount = errCount + 1
        Loop Until errCount > 10 'リトライ回数の上限
        '■指定したセル範囲と同じサイズのpicを新規作成し、保存する。
        Set pic = ActiveSheet.ChartObjects.Add(0, 0, rng.Width, rng.Height)
        pic.Chart.Export saveFolderPath & picName
        FileSize = FileLen(saveFolderPath & picName)
        '■picのFileSizeを超えるまでループする(画像データが出来上がったら終了する)
        Do Until FileLen(saveFolderPath & picName) > FileSize
            pic.Chart.Paste
            pic.Chart.Export saveFolderPath & picName
            DoEvents
        Loop
        '■作成完了後、pic削除。
        pic.Delete
        Set pic = Nothing
    Next i
    '■上書き保存
    'ThisWorkbook.Save
    'Application.DisplayAlerts = True
    'Application.ScreenUpdating = True
    'Application.Quit
End Sub

ランダム変更のコード

Sub ランダム変更()

    Dim rng As Range
    Dim cell As Range
    Dim randomNumber As Integer
    Dim emptyCount As Integer
    Dim emptyCell As Range

    ' 範囲を指定
    Set rng = Range("B2:H18")

    ' 各セルに対してランダムな数字を設定
    For Each cell In rng
        ' 1から7以下のランダムな数字を生成
        randomNumber = Int((7 - 1 + 1) * Rnd + 1)
        ' セルの値をランダムな数字に変更
        cell.Value = randomNumber
    Next cell

    ' ランダムな場所のセルを5か所空白にする
    emptyCount = 0
    Do Until emptyCount = 5
        ' ランダムなセルを選択
        Set emptyCell = rng.Cells(Int((rng.Cells.Count) * Rnd + 1))

        ' セルが既に空白でない場合、空白にする
        If emptyCell.Value <> "" Then
            emptyCell.Value = ""
            emptyCount = emptyCount + 1
        End If
    Loop
End Sub

< 使用 Excel:Excel2019、使用 OS:Windows10 >


 >Excel起動時にこのvbaが実行されません。

 何をもって、実行されない、とされているのでしょうか?

 プロシージャの先頭に、Debug.Print "START" とでも入れて、
 イミディエイトウィンドウで確認されたら、いかがでしょう。

 更に、いろいろな情報をイミディエイトウィンドウに吐き出せば、
 原因が分かるのでは?

(tkit) 2023/06/12(月) 10:34:05


 例えば
    Private Sub Workbook_Open()
        Stop '<--------------------ココで止まらないならイベント無効状態

 ちゃんと止まるんなら
 > このvbaが実行されません。
 との認識が誤りで他に原因がある。と。

 止まらなかった場合、イベント無効状態か否かを確認してみる。
 例えば
 標準モジュール側に[Auto_Open]書いて確認してみるとか...
 ([Auto_Open]はEnableEventsに影響されなかったと思う。)

    Sub Auto_Open()
        Debug.Print Application.EnableEvents
        Stop
    End Sub

(白茶) 2023/06/12(月) 11:01:59


tkitさん

イミディエイトウインドウでためしてみました。

詳しくないのであまりわかりませんが,実行した後ウインドウ内に
startとendが表示されたので問題ないということですか?
(appletea) 2023/06/12(月) 11:09:29


白茶さん

stopを追加して試してみました。

結果はstopで中断されました。

ということはvbaは実行されているということですか?
(appletea) 2023/06/12(月) 11:11:15


 >詳しくないのであまりわかりませんが,実行した後ウインドウ内に
 >startとendが表示されたので問題ないということですか?

 どこにendの出力を入れたか分かりませんが、
 取り合えず、start から end までのコードが実行された、
 ということです。

 問題かどうかは、ステップ実行しながら、想定と異なる要素や判定を
 確認してからですね。

(tkit) 2023/06/12(月) 11:36:32


>Excelを開いている状態で実行した場合は正常に動作します。
標準モジュールに移行して呼び出すとどうなるんでしょうね。
(IT) 2023/06/12(月) 12:01:20

 なんとなく想像です

 乱数使ってますけど、毎回Applicationを終了してしまうので、
 Randomize ステートメントで乱数の初期化しないと、毎回同じ乱数が発生している...
 ということではないでしょうか。

 できあがった画像ファイルのタイムスタンプを調べると、更新されているのではないでしょうか

 全部想像ですが。
(´・ω・`) 2023/06/12(月) 12:01:41

乱数の初期化が原因でした。

相談に乗っていただき、皆様ありがとうございました。
(appletea) 2023/06/12(月) 13:11:20


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.