Commandbotton zeitlich freigeben

Forumthread: Commandbotton zeitlich freigeben

Thomas

Ich brauche bitte Eure Hilfe!
Folgendes Problem:
Ich habe zwei Befehlsschaltflächen.
Sagen wir Button1 und Button2
Button1 soll immer von 8 Uhr bis 9 Uhr aktiv und grün sein.
Ist die Zeit überschritten, so soll der Button sich deaktivieren und und Farbe
soll sich auf rot ändern.
Button2 soll sich dann von 9 bis 10 Uhr aktivieren. Danach das Gleiche wie
Button1.
Vermutlich verwendet man hier die Application OnTime Methode?
Wer kann mir hier weiterhelfen.
Vielen Dank
Thomas

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

AW: Commandbotton zeitlich freigeben

Josef

AW: Commandbotton zeitlich freigeben

28.11.2011 21:17:46

Josef

Hallo Thomas,
den Tabellennamen und den Namen der Buttons ggf. anpassen!

' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call StopTimer
End Sub


Private Sub Workbook_Open()
  Call setButtonStatus
End Sub


' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public dblNextTime As Double
Public Const clngIntervall = 60    ' Intervall in Sekunden
Public Const cstrProc = "setButtonStatus"

Sub StartTimer()
  dblNextTime = Now + TimeSerial(0, 0, clngIntervall)
  Application.OnTime earliesttime:=dblNextTime, procedure:=cstrProc, _
    schedule:=True
End Sub


Sub setButtonStatus()
  
  With Sheets("Tabelle1")
    With .CommandButton1
      If Hour(Now) = 8 Then
        .BackColor = RGB(0, 255, 0)
        .Enabled = True
      Else
        .BackColor = RGB(255, 0, 0)
        .Enabled = False
      End If
    End With
    With .CommandButton2
      If Hour(Now) = 9 Then
        .BackColor = RGB(0, 255, 0)
        .Enabled = True
      Else
        .BackColor = RGB(255, 0, 0)
        .Enabled = False
      End If
    End With
  End With
  
  StartTimer
  
End Sub


Sub StopTimer()
  On Error Resume Next
  Application.OnTime earliesttime:=dblNextTime, _
    procedure:=cstrProc, schedule:=False
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

Forumthread: Commandbotton zeitlich freigeben

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread