รบกวนท่านอาจารย์ ช่วยเรื่อง code vba การcountdown

[sooksun2009]

ต้องการคลิก CommandButton39 แล้วให้ TextBox4 แสดง ตามcell ฺB5,TextBox8 แสดง ตามcell ฺB5,
TextBox7 แสดง ตามcell ฺC5,TextBox5 แสดง ตามcell ฺD5,TextBox6 แสดง ตามcell ฺE5,label60 แสดง ตามcell ฺF5,และกดปุม start ให้ TextBox4 countdown และ กดปุ่ม stop ให้TextBox4 หยุด countdown ขอบคุณครับ

Code: Select all

Private Sub CommandButton39_Click()
On Error GoTo ErrorHandler

With TextBox4
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
TextBox4.Value = Sheet2.Range("B5").Value
End With
With TextBox8
TextBox8.Value = Sheet2.Range("B5").Value
End With
With TextBox5
TextBox5.Value = Sheet2.Range("D5").Value
End With
With TextBox6
TextBox6.Value = Sheet2.Range("E5").Value
End With
With TextBox7
TextBox7.Value = Sheet2.Range("C5").Value
End With
End Sub


Private Sub CommandButton37_Click()
On Error GoTo ErrorHandler

With TextBox3
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
    .Value = Format(TimeValue(Now), "hh:mm:ss")
End With
End Sub
Private Sub CommandButton38_Click()
On Error GoTo ErrorHandler

With TextBox2
    .Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
    .Value = Format(TimeValue(Now), "hh:mm:ss")
End With
End Sub


'Private Sub TextBox4_Change()
Sub startTimer()
Application.OnTime Now + TimeValue("00:00:01"), "nextTick"
End Sub

'Macro for next second
Sub nextTick()
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
startTimer
End Sub

'Macro for stopping the timer (attached to the end button)
Sub stopTimer()
Application.OnTime Now - TimeValue("00:00:01"), "nextTick", , False
End Sub

[sooksun2009]

ไม่มีใครช่วยได้เลย

[snasui]

ไม่มีใครช่วยได้เลย

ช่วงนี้ผมยังไม่สะดวกเข้ามาตอบครับ

ที่เขียนมาเองแล้วนั้น ปัจจุบันติดปัญหาตรงไหน อย่างไร ค่อย ๆ ถามตอบกันไป ทำให้ผ่านไปทีละขั้นครับ

[sooksun2009]

textbox ให้แสดงเป็น hh:mm:ss ครับ

[sooksun2009]

ไม่มีใครช่วยได้เลย

ช่วงนี้ผมยังไม่สะดวกเข้ามาตอบครับ

ที่เขียนมาเองแล้วนั้น ปัจจุบันติดปัญหาตรงไหน อย่างไร ค่อย ๆ ถามตอบกันไป ทำให้ผ่านไปทีละขั้นครับ

อยาก Textbox 4 รับค่าจาก จาก sheet5 cell B2 แล้วให้ Format เป็น hh:mm:ss ครับ ขอบคุณครับ

Code: Select all

Private Sub ComboBox2_Change()
Sheet5.Range("A2").Value = ComboBox2.Value
Label60.Caption = Sheet5.Range("F2").Value
Label131.Caption = ComboBox2.Value
With TextBox4
On Error GoTo ErrorHandler
TextBox4.Value = Format(TimeValue(.Value), "hh:mm:ss")
ErrorHandler:
TextBox4.Value = Sheet5.Range("B2").Value

End With
With TextBox8
TextBox8.Value = Sheet5.Range("B2").Value
End With
With TextBox5
TextBox5.Value = Sheet5.Range("D2").Value
End With
With TextBox6
TextBox6.Value = Sheet5.Range("E2").Value
End With
With TextBox7
TextBox7.Value = Sheet5.Range("C2").Value

End With
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub ComboBox2_Change()
    Sheet5.Range("A2").Value = ComboBox2.Value
    Label60.Caption = Sheet5.Range("F2").Value
    Label131.Caption = ComboBox2.Value
    With TextBox4
        .Value = Format(Sheet5.Range("B2").Value, "h:mm:ss")
    End With
'Other code

[sooksun2009]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub ComboBox2_Change()
    Sheet5.Range("A2").Value = ComboBox2.Value
    Label60.Caption = Sheet5.Range("F2").Value
    Label131.Caption = ComboBox2.Value
    With TextBox4
        .Value = Format(Sheet5.Range("B2").Value, "h:mm:ss")
    End With
'Other code

ขอบคุณอาจารย์มากครับ มีคำถามเพิ่มครับ อยากกดปุ่ม start แล้วให้ TextBox4 นัยถอยหลังครับ

Code: Select all

Private Sub CommandButton38_Click()
starttimer1
TextBox4.Value = Sheet5.Range("G2").Value
With TextBox4
.Value = Format(Sheet5.Range("G2").Value, "h:mm:ss")
End With
End Sub
Sub starttimer1()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick1"
End Sub
Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
        Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
    starttimer1
    If TextBox4 = 0 Then Exit Sub
           TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
End Sub
Sub stopTimer1()
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "nexttick1", , False
End Sub

[sooksun2009]

TextBox4 นับถอยหลังครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

เพิ่ม Event Change ไปที่ Sheet Dynamic ตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub

ปรับ nexttick1 เป็นตามด้านล่างครับ

Code: Select all

Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
    Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
'    If TextBox4 = 0 Then Exit Sub
'    TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
    starttimer1
End Sub

[sooksun2009]

ตัวอย่างการปรับ Code ครับ

เพิ่ม Event Change ไปที่ Sheet Dynamic ตามด้านล่างครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub

ปรับ nexttick1 เป็นตามด้านล่างครับ

Code: Select all

Sub nexttick1()
    If Sheet5.Range("G2") = 0 Then Exit Sub
    Sheet5.Range("G2").Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
'    If TextBox4 = 0 Then Exit Sub
'    TextBox4.Value = Sheet5.Range("G2").Value - TimeValue("00:00:01")
'    starttimer1
    If Sheet5.Range("G2").Value < TimeValue("00:01:00") Then Beep
    starttimer1
End Sub

ขอบคุณครับอาจารย์ แต่ติดปัญหาอยู่นิดหนึ่งครับ เวลาผมกดปุ่ม Save ติด Bug ครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "G2" Then
        With UserForm1.TextBox4
            .Value = Format(Range("g2").Value, "h:mm:ss")
        End With
    End If
End Sub

save code

Code: Select all

Private Sub CommandButton36_Click()
Sheet3.Activate
Dim irow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("Save")
    'find first empty row in database
    irow = ws.Cells(Rows.Count, 2) _
        .End(xlUp).Offset(1, 0).Row
    'Check for Id
    If Trim(Me.ComboBox2.Value) = "" Then
        Me.ComboBox2.SetFocus
        MsgBox "a~E^e`^(a)?e`I'E^O^^(1)?e'O`"
        Exit Sub
    End If
    'copy the data to the database
    ws.Cells(irow, 1).Value = Me.ComboBox2.Value
    ws.Cells(irow, 2).Value = Me.TextBox1.Value
    ws.Cells(irow, 3).Value = Me.TextBox2.Value
    ws.Cells(irow, 4).Value = Me.TextBox3.Value
    ws.Cells(irow, 5).Value = Me.TextBox4.Value
    ws.Cells(irow, 6).Value = Me.TextBox8.Value
    ws.Cells(irow, 7).Value = Me.TextBox7.Value
    ws.Cells(irow, 8).Value = Me.TextBox5.Value
    ws.Cells(irow, 9).Value = Me.TextBox6.Value
    'Clear the data
    Me.ComboBox2.Value = ""
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.TextBox8.Value = ""
    Me.TextBox7.Value = ""
    Me.TextBox6.Value = ""
    Me.TextBox5.Value = ""
    ActiveWorkbook.Save
End Sub

[snasui]

แนบไฟล์ล่าสุดที่ได้ Update Code ตามด้านบนมาแล้วด้วย เพื่อจะได้สะดวกในการทดสอบครับ

[sooksun2009]

แนบไฟล์ล่าสุดที่ได้ Update Code ตามด้านบนมาแล้วด้วย เพื่อจะได้สะดวกในการทดสอบครับ

ขอบคุณครับ

[snasui]

ที่ปุ่ม Save ให้ยกเลิกการ Enable Event และกำหนดใหม่ตามตัวอย่างด้านล่างครับ

Code: Select all

Private Sub CommandButton36_Click()
    Application.EnableEvents = False
    'Other code
    Application.EnableEvents = True
End Sub