[[20090420091851]]　『指定のセルの点滅停止ボタン』（みこ）　ページの最後に飛ぶ

『指定のセルの点滅停止ボタン』（みこ）
指定のセルを点滅させるマクロを、あるサイトからいただいたのですが、点滅を止めるのに別のシ－トに移動しないと止まらないようになっています。
点滅画面にボタンを作って、点滅を停止したいのですが　どのようにしたらわかりません。
マクロ初心者なので　良きアドバイスをお願いします。

Sub auto_open()
ActiveSheet.Protect Password:="pass", DrawingObjects:=True, _

        contents:=True, UserInterfaceonly:=True

        MsgBox "今日は、" & Day(Now) & "日です。入力する場合は、日付点滅を解除して入力してください。", _
        vbInformation, Year(Now) & "年" & Month(Now) & "月"

        Dim selR As Range
  Dim selId() As Integer
  Dim selNum As Integer
  Dim i As Integer, colorId(1) As Integer
  Dim counter As Integer, setTime, flash
  Dim MySht As String               '追加
  Set selR = Range("A11,g1") '点滅させるセル範囲
  selNum = selR.Count
  colorId(0) = 3                    '点滅色
  colorId(1) = 2                    '　〃
  MySht = ActiveSheet.Name          '追加
  ReDim selId(1 To selR.Count)
  For i = 1 To selR.Count
    selId(i) = selR(i).Font.ColorIndex
  Next i
  While MySht = ActiveSheet.Name    '変更
    For Each flash In colorId
      selR.Font.ColorIndex = flash
      setTime = Timer
      Do
        DoEvents
      Loop Until Timer >= setTime + 0.3
    Next flash
  Wend                              '変更
  For i = 1 To selR.Count
    selR(i).Font.ColorIndex = selId(i)
  Next i
        End Sub

 ちょっと変更しましたが、

 アクティブシートにコマンドバー「フォーム」のボタンを適当な位置に配置してください。

 標準モジュールに

 '===========================================================================
 Option Explicit
 Private stop_tmt As Boolean
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Sub auto_open()
    Dim crng As Range
    Dim selR As Range
    Dim selId() As Integer
    Dim selNum As Integer
    Dim i As Integer, colorId(1) As Integer
    Dim counter As Integer, setTime, flash
    Dim MySht As String               '追加
    ActiveSheet.Protect Password:="pass", DrawingObjects:=True, _
        contents:=True, UserInterfaceonly:=True
    MsgBox "今日は、" & Day(Now) & "日です。入力する場合は、日付点滅を解除して入力してください。", _
        vbInformation, Year(Now) & "年" & Month(Now) & "月"

    Set selR = Range("A11,g1") '点滅させるセル範囲
    selNum = selR.Count
    colorId(0) = 3                    '点滅色
    colorId(1) = 2                    '　〃
    MySht = ActiveSheet.Name          '追加
    ReDim selId(1 To selR.Count)
    i = 1
    For Each crng In selR
       selId(i) = crng.Font.ColorIndex
       i = i + 1
    Next
    stop_tmt = False
    selR.Font.ColorIndex = colorId(0)
    Do Until stop_tmt     '変更
       With selR.Font
         .ColorIndex = .ColorIndex Xor (colorId(0) Xor colorId(1))
       End With
       DoEvents
       Sleep 300
       DoEvents
    Loop                              '変更
    i = 1
    For Each crng In selR
       crng.Font.ColorIndex = selId(i)
       i = i + 1
    Next
 End Sub
 '==================================================================
 Sub stop_tenmetu()
    stop_tmt = True
 End Sub

 配置したボタンには、上記のstop_tenmetuというマクロを登録して試してみてください。

 尚、シートの保護をコードでしているみたいなので、一度解除してた後、ボタンを配置してください。

 ichinose

ichinoseさん、ありがとうございます。
「Sub stop_tenmetu()

    stop_tmt = True
 End Sub
 配置したボタンには、上記のstop_tenmetuというマクロを登録して試してみてください。」
ボタンを作成するとSub stop_tenmetu()→Sub ボタン1_Click()になってしまうのですが、どのようにすればよいのですか、お願いします。(みこ)

 では、一度　シート保護を解除し、先に作成したボタンも削除した状態で、
　標準モジュールに

 '=================================================================
 Sub set_button()
    Dim r As Range

    With ActiveSheet
       Set r = .Range("l2:m3")
       With .Buttons.Add(r.Left, r.Top, r.Width, r.Height)
          .Caption = "点滅停止"
          .OnAction = "stop_tenmetu"
       End With
    End With
    set r=Nothing
 End Sub

 これを実行してください(尚、前回投稿のコードはそのまま使います)。

 上記のset_buttonを実行すると、アクティブシートに点滅停止用のボタンが作成されますので、
 これで試してみてください。

 ichinose

ichinoseさん、返事が遅れて申し訳ありません。できました、感激>>>
ご伝授いただきありがとうございました。私も、ichinoseさんの足元ぐらいにはおよべる様に勉強したいと思っています。繰替えしますが、本当にありがとうございました。(みこ)

コメント返信：

[ 一覧(最新更新順) ]

[[20090420091851]] 『指定のセルの点滅停止ボタン』（みこ） ページの最後に飛ぶ

[[20090420091851]]　『指定のセルの点滅停止ボタン』（みこ）　ページの最後に飛ぶ