VBA-Code + Timer

Question

Ich versuche, diesen Code auszuführen, aber es gab mir einen Fehler. Die beiden Codes laufen getrennt voneinander. Aber wenn ich die beiden Codes kombiniere, laufen sie nicht gut, um die gewünschten Ergebnisse zu erzielen. Kann mir jemand helfen?

Sub Macro1() 
' 
' Macro1 Macro 
' 

' 
    Application.ScreenUpdating = False 
    Range("X12").Select 
    Selection.Copy 
    Range("W12").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

    If Bt 1.Range("Z3") = 0 Then Exit Sub 
     Bt1.Range("Z3").Value = Bt 1.Range("z3").Value - TimeValue("00:00:01") 

    If Bt 1.Range("z3").Value <= TimeValue("00:00:10") Then 
     Bt 1.Sheepes("TextBox 1").Fill.ForceColor.RGB = RGB(255, 0, 0) 

    Else 
     Bt 1.Shapes("TextBox1").Fill.ForceColor.RGB = RGB(255, 255, 255) 

    End If 
     Application.OnTime Now + TimeValue("00:00:01"), "nexttick" 
End Sub 

Answer 1

Neben den falschen Codezeilen wie in den Kommentaren (besonderer Dank an @Mrig) erwähnt, wird der Code einige Prüfungen fehlen, dass alles an seinem Platz zu überprüfen, für den Code zu arbeiten. So, hier ist der Code mit den richtigen Einstellungen:

Option Explicit 

Sub Macro1() 

Dim shp As Shape 
Dim ws As Worksheet 
Dim bolFound As Boolean 

Application.ScreenUpdating = False 

'Checking if there is a sheet 'Bt 1' 
bolFound = False 
For Each ws In ThisWorkbook.Worksheets 
    If ws.Name = "Bt 1" Then bolFound = True 
Next ws 
If bolFound = False Then 
    MsgBox "Required sheet 'Bt 1' not found." & Chr(10) & "Aborting..." 
    Exit Sub 
End If 

With ThisWorkbook.Worksheets("Bt 1") 
    'Copying the value from X12 to W12 
    .Range("W12").Value2 = .Range("X12").Value2 
    'Checking Z3 before proceeding 
    If .Range("Z3") = 0 Then 
     MsgBox "Z3 is 0." & Chr(10) & _ 
      "Aborting..." 
     Exit Sub 
    End If 
    If Not IsNumeric(.Range("Z3").Value) Then 
     MsgBox "Z3 on the sheet 'Bt 1' is not a date/time." & Chr(10) & _ 
      "Therefore a second cannot be subtracted from Z3." & Chr(10) & _ 
      "Aborting..." 
     Exit Sub 
    End If 
    .Range("Z3").Value = .Range("Z3").Value - TimeValue("00:00:01") 
    'Checking if there is a 'TextBox 1' 
    bolFound = False 
    For Each shp In .Shapes 
     If shp.Name = "TextBox 1" Then bolFound = True 
    Next shp 
    If bolFound = False Then 
     MsgBox "Required shape 'TextBox 1' not found." & Chr(10) & "Aborting..." 
     Exit Sub 
    End If 
    If .Range("Z3").Value <= TimeValue("00:00:10") Then 
     .Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 0, 0) 
    Else 
     .Shapes("TextBox 1").Fill.ForeColor.RGB = RGB(255, 255, 255) 
    End If 
End With 

Application.OnTime Now + TimeValue("00:00:01"), "nexttick" 
Application.ScreenUpdating = True 

End Sub 

Auch wenn der Code nicht wie erwartet laufen sollten Sie ausreichend Feedback erhalten, um die notwendigen Korrekturen vornehmen (für den Code auszuführen).

Lassen Sie mich wissen, wenn Sie weitere Fragen haben.