ต้องการให้เวลาในuserformเปลี่ยนตามเครื่องค่ะ

[thinatda]

Code: Select all

Dim MyTime
Me.TextBox9 = DateTime.Now
alerttime = Now + TimeValue("00:00:01")

[logic]

ทำตามกฎข้อ 3 ของบอร์ดด้วยครับ

[thinatda]

Code: Select all

Dim MyTime
Me.TextBox9 = DateTime.Now
alerttime = Now + TimeValue("00:00:01")

ต้องการให้เวลาในuserformแสดงเวลาตามเครื่องค่ะตอนนี้แสดงเวลาแล้วแต่ไม่ตามเครื่องค่ะ

[logic]

ลองอันนี้

ใส่ใน userform

Code: Select all

Sub UserForm_Initialize()
    Call StartTimer
End Sub


Private Sub UserForm_Terminate()
    Call EndTimer
End Sub

ใส่ใน module

Code: Select all

#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As LongLong, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As Long
    
    Public Declare PtrSafe Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#Else
    Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If


Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long

'~~> Start Timer
Sub StartTimer()
    '~~ Set the timer for 1 second
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'~~> End Timer
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
    '~~> Update value in Sheet 1
    Sheet1.Range("A1").Value = Time  ' <~~ โชว์ในเซลล์
    UserForm1.Label1.Caption = Time ' <~~ โชว์ใน label
    UserForm1.TextBox1.Text = Time ' <~~ โชว์ใน textbox
End Sub

ต้นแหล่ง ~~> https://stackoverflow.com/questions/118 ... k-in-excel

[thinatda]

ลองอันนี้

ใส่ใน userform

Code: Select all

Sub UserForm_Initialize()
    Call StartTimer
End Sub


Private Sub UserForm_Terminate()
    Call EndTimer
End Sub

ใส่ใน module

Code: Select all

#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As LongLong, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As Long
    
    Public Declare PtrSafe Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#Else
    Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If


Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long

'~~> Start Timer
Sub StartTimer()
    '~~ Set the timer for 1 second
    TimerSeconds = 1
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'~~> End Timer
Sub EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
    '~~> Update value in Sheet 1
    Sheet1.Range("A1").Value = Time  ' <~~ โชว์ในเซลล์
    UserForm1.Label1.Caption = Time ' <~~ โชว์ใน label
    UserForm1.TextBox1.Text = Time ' <~~ โชว์ใน textbox
End Sub

ต้นแหล่ง ~~> https://stackoverflow.com/questions/118 ... k-in-excel

ติดช่วงนี้ค่ะ ขึ้นแดงหมดเลยค่ะ

Code: Select all

#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As LongLong, _
    ByVal uElapse As Long, ByVal lpTimerFunc As LongLong) As Long
    
    Public Declare PtrSafe Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#Else
    Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
    Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If

[logic]

ขอดูไฟล์ที่ใส่ code นี้เข้าไปแล้วครับ

[thinatda]

ขอดูไฟล์ที่ใส่ code นี้เข้าไปแล้วครับ

โค้ดใส่ไว้ในชื่อ รายรับ1 กับ ชื่อ Module1 ค่ะ

[logic]

ลองอันนี้แทนครับ จากแหล่งเดิม

ใน UserForm

Code: Select all

Private Sub UserForm_Initialize()
    Call Start_Timer
End Sub
Private Sub UserForm_Terminate()
    Call Stop_Timer
End Sub

ใน Module

Code: Select all

Dim TimerActive As Boolean
Sub StartTimer()
    Start_Timer
End Sub
Public Sub Start_Timer()
    TimerActive = True
    Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End Sub
Public Sub Stop_Timer()
    TimerActive = False
End Sub
Private Sub Timer()
    If TimerActive Then
'        ActiveSheet.Cells(1, 1).Value = Time
        รายรับ1.Label18.Caption = Time
        Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
    End If
End Sub

[thinatda]

ลองอันนี้แทนครับ จากแหล่งเดิม

ใน UserForm

Code: Select all

Private Sub UserForm_Initialize()
    Call Start_Timer
End Sub
Private Sub UserForm_Terminate()
    Call Stop_Timer
End Sub

ใน Module

Code: Select all

Dim TimerActive As Boolean
Sub StartTimer()
    Start_Timer
End Sub
Public Sub Start_Timer()
    TimerActive = True
    Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End Sub
Public Sub Stop_Timer()
    TimerActive = False
End Sub
Private Sub Timer()
    If TimerActive Then
'        ActiveSheet.Cells(1, 1).Value = Time
        รายรับ1.Label18.Caption = Time
        Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
    End If
End Sub

ติดเหลืองค่ะ

Code: Select all

Private Sub UserForm_Terminate()
    Call EndTimer
End Sub

[logic]

โค้ดที่ยกมาผมเขียนไปแบบหนึ่งเอาไปใช้เป็นอีกแบบหนึ่ง ติดก็ไม่แปลกครับ

[thinatda]

โค้ดที่ยกมาผมเขียนไปแบบหนึ่งเอาไปใช้เป็นอีกแบบหนึ่ง ติดก็ไม่แปลกครับ

แก้ได้แล้วค่ะ ขอบคุณค่ะ