แจ้งผลการทดสอบไฟล์ครับ :')
ไฟล์ทำงานได้ตรงตามที่กำหนด และสมบูรณ์ครับ
ผมไม่ได้เปลี่ยน Now() เป็น Time() นะครับ
เพราะกลัวว่าพอเอา Code นี้ ไปใส่ในไฟล์ที่ใช้งานจริงจะต้องไล่เปลี่ยนทั้งหมด
ขอขอบคุณ คุณ snasui สำหรับคำแนะนำนะครับ ^^
ด้วยความเคารพครับ
*ป.ล. ด้านล่าง คือ ตัวอย่าง Code และไฟล์ ที่ใช้งานได้สมบูรณ์
เผื่อว่าพอจะประโยชน์บ้าง ไม่มาก ก็น้อย
Code: Select all
Option Explicit
Public dTime As Date
Public aTime As Date
Public bTime As Date
Public OpenT1 As Date
Public OpenT2 As Date
Public BreakT As Date
Public CloseT As Date
Sub ValueStore()
Dim NC As Long
With Sheets("VolCalculation")
NC = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
.Cells(2, NC).Resize(2).Value = .Range("C2:C3").Value
If NC > 30 Then .Range("D2:D3").Delete xlShiftToLeft
End With
Application.CutCopyMode = False
Call StartTimer
End Sub
Sub StartTimer()
Dim t As String
With Sheets("VolCalculation")
t = Format(.Range("G8").Value, "00")
t = t & ":" & Format(.Range("H8").Value, "00")
t = t & ":" & Format(.Range("I8").Value, "00")
End With
dTime = Now + TimeValue(t)
Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime dTime, "ValueStore", Schedule:=False
End Sub
Sub ResetTimer()
With Sheets("VolCalculation")
.Range("D2:XFD3").ClearContents
End With
End Sub
Sub AutoOn()
Call StartTimer
End Sub
Sub AutoOff()
Call StopTimer
End Sub
Sub ConditionAuto()
aTime = Format(Now(), "HH:mm:ss")
OpenT1 = Format(TimeValue("08:20:00"), "HH:mm:ss")
BreakT = Format(TimeValue("08:22:00"), "HH:mm:ss")
OpenT2 = Format(TimeValue("08:35:00"), "HH:mm:ss")
CloseT = Format(TimeValue("08:36:00"), "HH:mm:ss")
If aTime >= OpenT1 And aTime <= BreakT Then
Call AutoTimer1
ElseIf aTime > BreakT And aTime < OpenT2 Then
Call AutoTimer2
ElseIf aTime >= OpenT2 And aTime <= CloseT Then
Call AutoTimer3
Else
Call AutoTimer0
End If
End Sub
Sub AutoTimer0()
OpenT1 = Format(TimeValue("08:20:00"), "HH:mm:ss")
BreakT = Format(TimeValue("08:22:00"), "HH:mm:ss")
OpenT2 = Format(TimeValue("08:35:00"), "HH:mm:ss")
CloseT = Format(TimeValue("08:36:00"), "HH:mm:ss")
Application.OnTime OpenT1, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime OpenT1 + TimeValue("00:00:01"), "AutoOn", Schedule:=False
Application.OnTime BreakT, "AutoOff"
Application.OnTime OpenT2, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime OpenT2 + TimeValue("00:00:01"), "AutoOn", Schedule:=False
Application.OnTime CloseT, "AutoOff"
End Sub
Sub AutoTimer1()
aTime = Now()
bTime = Now + TimeValue("00:00:01")
BreakT = Format(TimeValue("08:22:00"), "HH:mm:ss")
OpenT2 = Format(TimeValue("08:35:00"), "HH:mm:ss")
CloseT = Format(TimeValue("08:36:00"), "HH:mm:ss")
Application.OnTime aTime, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime bTime, "AutoOn", Schedule:=False
Application.OnTime BreakT, "AutoOff"
Application.OnTime OpenT2, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime OpenT2 + TimeValue("00:00:01"), "AutoOn", Schedule:=False
Application.OnTime CloseT, "AutoOff"
End Sub
Sub AutoTimer2()
OpenT2 = Format(TimeValue("08:35:00"), "HH:mm:ss")
CloseT = Format(TimeValue("08:36:00"), "HH:mm:ss")
Application.OnTime OpenT2, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime OpenT2 + TimeValue("00:00:01"), "AutoOn", Schedule:=False
Application.OnTime CloseT, "AutoOff"
End Sub
Sub AutoTimer3()
aTime = Now()
bTime = Now + TimeValue("00:00:01")
CloseT = Format(TimeValue("08:36:00"), "HH:mm:ss")
Application.OnTime aTime, "AutoOn", Schedule:=True
On Error Resume Next
Application.OnTime bTime, "AutoOn", Schedule:=False
Application.OnTime CloseT, "AutoOff"
End Sub
You do not have the required permissions to view the files attached to this post.