◆Workbook_Open()でマクロの自動実行がされません◆

Question

VBA初心者です。マクロの自動実行がうまくいかず、長い事悩んでおります。

ご教示頂けたら幸いです。

　⋆Win7

　⋆EXCEL2010使用

ブックを開いた時に、セルZ23の期日を参照にセル１が本日より過去であれば、セル（G26:AJ27）を黒く塗りつぶすというマクロを作成しております。

このシート内に上記と同じ内容を実行するセルがあと３つあります。

実際のコードは下記になります。

Private Sub Workbook_Open()

ActiveSheet.Unprotect

’①

If Range("Z23").Value = Date Then

Range("G26:AJ27").Interior.Color = RGB(250, 240, 230)   'リネン　空白何も処理しない

ElseIf Range("Z23").Value = "" Then

Range("G26:AJ27").Interior.Color = RGB(250, 240, 230)   'リネン　空白何も処理しない

ElseIf Range("Z23").Value <= Date Then

Range("G26:AJ27").Interior.Color = RGB(0, 0, 0)  '黒

②～④はセル番号が違うだけです。

End If

End If

End If

End If

End Sub

上記①～④を纏めて記述する方法が初心者で今いち分からないものですから、②～④は①をコピーしてセル番号だけ変えております。

使用する方がこのBookを開いた時に、自動実行される様にしたいのですが、開いた時に①と②しか実行されません。また日によっては①だけが実行されたりもします。

これはバグか何かなのでしょうか？

初心者で申し訳ございませんが、宜しくお願い致します。

Answer 1

> その上で頂いたプロシージャーを記述し実行させて頂いきましたが・・・

> 　同じく・・一部しか動きません。

> 　色が黒くマスキングされたのは情報①だけでした。

現時点では「 Z37, Z51, Z65 の 3 つのセルに格納されているのは

本日より過去の日付ではない」からであるとしか考えられません。

（今日実行した場合は「 2019/09/27 より過去の日付（今日は含まれない）」）

とりあえず、Workbook_Open プロシージャを実行されてから

イミディエイトウィンドウに出力されているテキストの内容を

ご確認されることをお奨めします。

Answer 2

sk.exe様

ご回答頂き有難うございました。

プロシージャーを見ながら暫く勉強させて頂きました。

その上で頂いたプロシージャーを記述し実行させて頂いきましたが・・・

　同じく・・一部しか動きません。

　色が黒くマスキングされたのは情報①だけでした。

折角ご尽力頂いたのに、大変申し訳なく思っております。

引き続き頑張って検証してみます。

この度は本当に有難うございました。

大変勉強になりました。

また機会がございましたら宜しくお願い致します。

Answer 3

なるほど。要は、各セル範囲の参照位置を行方向に14 行ずつずらしながら、

塗りつぶし処理を4回実行出来ればよい、ということですよね。

（ ThisWorkbook モジュール）

---

Option Explicit

Private Sub Workbook_Open()

    '定数の宣言

    Const FirstDeadlineAddress As String = "Z23"    '最初の期日セルのアドレス

    Const FirstTargetAddress As String = "G26:AJ27" '最初のターゲットセルのアドレス

    Const RowStep As Long = 14                      '何行ずつステップさせるか

    Const LoopMax As Long = 4                       '何回ループさせるか

    '変数の宣言

    Dim rngDeadline As Excel.Range

    Dim rngTarget As Excel.Range

    Dim lngCount As Long

    Dim lngRowOffset As Long

    'ループ処理

    For lngCount = 0 To (LoopMax - 1) Step 1

        '行方向のオフセット値を取得

        lngRowOffset = RowStep * lngCount

        '期日セルを参照

        Set rngDeadline = Range(FirstDeadlineAddress).Offset(lngRowOffset, 0)

        '塗りつぶしの設定対象となるセルを参照

        Set rngTarget = Range(FirstTargetAddress).Offset(lngRowOffset, 0)

        'デバッグ用

        Debug.Print rngDeadline.Address(False, False) & " / " & rngTarget.Address(False, False)

        Debug.Print rngDeadline.Address(False, False) & " の値は " & rngDeadline.Value

        '塗りつぶし処理の呼び出し

        Call SetInterior(rngDeadline.Value, rngTarget)

        '参照解放

        Set rngTarget = Nothing

        Set rngDeadline = Nothing

    Next

End Sub

'引数 DeadlineDate に渡された日付に応じて

'引数 Target に参照渡しされたセル範囲の塗りつぶしを設定する

'サブルーチン

Private Sub SetInterior(DeadlineDate As Variant, Target As Excel.Range)

    'セル範囲の塗りつぶしの初期化

    Target.Interior.Color = RGB(250, 240, 230)

    'ちなみに「塗りつぶしなし」にするなら以下のコード

    'Target.Interior.ColorIndex = xlColorIndexNone

    '期日として渡された値が日付/時刻型のデータとして評価できない場合

    If IsDate(DeadlineDate) = False Then

        'プロシージャを抜ける

        Exit Sub

    End If

    '期日が現在のシステム日付より過去の日付である場合

    If CDate(DeadlineDate) < Date Then

        'セル範囲を黒く塗りつぶす

        Target.Interior.Color = RGB(0, 0, 0)

    End If

End Sub

---

Answer 4

ご回答頂き有難うございました。

省略してしまって申し訳ございませんでした。

＞もっとシンプルなコードで何とかなるのではないか

　Andを使用してみたり、変数を使用してみたりしたものの常に一部しか動かない為、すべてストレートに記述してみました。

お恥ずかしながら全体は下記の様になります。

Private Sub Workbook_Open()

　　ActiveSheet.Unprotect

'情報①

    If Range("Z23").Value = Date Then

      Range("G26:AJ27").Interior.Color = RGB(250, 240, 230)   'リネン　

       ElseIf Range("Z23").Value = "" Then

          Range("G26:AJ27").Interior.Color = RGB(250, 240, 230)   'リネン　

             ElseIf Range("Z23").Value <= Date Then

                  Range("G26:AJ27").Interior.Color = RGB(0, 0, 0)  '黒

'情報②

 If Range("Z37").Value = Date Then

      Range("G40:AJ41").Interior.Color = RGB(250, 240, 230)   'リネン　

       ElseIf Range("Z37").Value = "" Then

          Range("G40:AJ41").Interior.Color = RGB(250, 240, 230)   'リネン　

             ElseIf Range("Z37").Value <= Date Then

                  Range("G40:AJ41").Interior.Color = RGB(0, 0, 0)  '黒

'情報③

    If Range("Z51").Value = Date Then

      Range("G54:AJ55").Interior.Color = RGB(250, 240, 230)   'リネン　

       ElseIf Range("Z51").Value = "" Then

          Range("G54:AJ55").Interior.Color = RGB(250, 240, 230)   'リネン　

             ElseIf Range("Z51").Value <= Date Then

                  Range("G54:AJ55").Interior.Color = RGB(0, 0, 0)  '黒

'情報④

  If Range("Z65").Value = Date Then

      Range("G68:AJ69").Interior.Color = RGB(250, 240, 230)   'リネン　

       ElseIf Range("Z65").Value = "" Then

          Range("G68:AJ69").Interior.Color = RGB(250, 240, 230)   'リネン　

             ElseIf Range("Z65").Value >= Date Then

                  Range("G68:AJ69").Interior.Color = RGB(0, 0, 0)  '黒

          End If

        End If

       End If

    End If

End Sub

引き続きご教示頂けると幸いです。

宜しくお願い致します。

Answer 5

> このシート内に上記と同じ内容を実行するセルがあと３つあります。

> ②～④はセル番号が違うだけです。

> 上記①～④を纏めて記述する方法が初心者で今いち分からないものですから、

> ②～④は①をコピーしてセル番号だけ変えております。

（ここでいう①というのが セル範囲 G26:AJ27 を指しているとして）

そのように実際のコードを省略されてしまうと、②、③、④に対する処理において

具体的にどのセル範囲のアドレスをどのように書き換えたのか、

また各セル範囲の塗りつぶしの色を設定するコードをどのタイミングで

呼び出しているのかが判らなくなります。

それが判らない限りは、「どこの部分のコードが間違っているのか」

「正しく実行されない原因は何なのか」ということについて

第三者には検証も指摘も出来ません。

> ブックを開いた時に、セルZ23の期日を参照にセル１が本日より過去であれば、

> セル（G26:AJ27）を黒く塗りつぶすというマクロを作成しております。

単純に Z23 セルの値のみを条件分岐の評価要素とされているのであれば、

もっとシンプルなコードで何とかなるのではないか、というのが

今のところの印象です。