กระทู้เก่าบอร์ด อ.สุภาพ ไชยา
388 10
URL.หัวข้อ /
URL
ต้องการให้เตือนโดยหักวันหยุด
ผมมี Table ที่เก็บวันหยุดในแต่ละปีไว้ และมี Table ที่ทำรายการเก็บข้อมูลในแต่ละ Record ผมต้องการให้ข้อมูลนั้นแสดงขึ้นมาหลังจากวันที่ทำรายการ 3 วัน ถ้าวันที่ 3 ตรงกับวันหยุดตามที่ Table ที่ผมเก็บวันหยุดไว้ให้เลื่อนจนกระทั่งเป็นวันทำงานปกติ ไม่ทราบว่ามีแนวทางการเขียนอย่างไรบ้างครับ
10 Reply in this Topic. Dispaly 1 pages and you are on page number 1
1 @R01593
ขออนุญาตครับ อ. สุภาพ
ลองเอาตัวอย่างนี้ไปปรับใช้ดูนะครับ
2 @R01594
ผมพยายามลองแล้วแต่คิดว่าไม่ใช่อย่างที่ต้องการครับ
3 @R01597
ไม่ทราบได้ดูโค้ดนี้ที่คุณ ศรี-นคร ให้ไว้ใน Module หรือเปล่าครับ
Function fnGetDueDate(iDate As Date, iNextDay As Integer) As Date
Dim tDate As Date
Rem ***** Find next date for n days (iNextDay)
tDate = iDate + iNextDay
Rem ***** Check If Saturday or Sunday Skip to Monday
If Format(tDate, "DDD") = "SAT" Then
Rem ***** If result is saturday skip 2 day is monday
tDate = tDate + 2
Else
If Format(tDate, "DDD") = "SUN" Then
Rem ***** If result is sunday skip to 1 day is monday
tDate = tDate + 1
End If
End If
fnGetDueDate = tDate
End Function
เป็นโค้ดที่เขียนไว้ดีมากครับ เพียงแต่ไม่มีการนับวันหยุดพิเศษในตารางเท่านั้นครับ
หรือจะลองดูกระทู้นี้ http://www.thai-access.com/suphap.php?topic_id=189
หรืที่ของต่างประเทศที่ผมได้ตอบเขาไว้ที่ http://www.utteraccess.com/forums/showflat.php?Cat=&Board=access_97&Number=174403
ซึ่งเป็นการหาวันย้อนหลังครับ
ลองปรับใช้ดู และถ้าพบบักกรุณาแจ้งบักเข้ามาให้ทราบด้วยครับ เพราะผมเองยังไม่ได้ลองใช้อย่างจริงจังเสียที
4 @R01602
ผมได้ลองนำ code ของอาจารย์ทดสอบดูครับ ปรากฎว่าเมื่อวันที่ตรงกับวันเสาร์ ก็เปลี่ยนเป็นวันอาทิตย์ ซึ่งเป็นวันหยุด ไม่ถูกต้อง ส่วนวันหยุดพิเศษในตารางผมยังไม่ได้ทดสอบเนื่องจากวันหยุดธรรมดายังไม่ถูกต้องครับ ไม่ทราบว่ามีผิดพลาดตรงไหนขอให้อาจารย์ช่วยชี้แนะด้วยครับ ผมสามารถรันได้ปกติไม่มีบักครับ
5 @R01603
ลองทดสอบตัวนี้ดูครับ
Function MyDeadLine(BegDate As Variant, intType As Integer, intDays As Integer) As Date
Dim i As Integer, intHolidays As Integer
Dim DateCnt As Variant
Dim EndDays As Integer
BegDate = DateValue(BegDate)
EndDays = 0
DateCnt = BegDate
For i = 1 To intDays
If intType = 1 Then
If Format(DateCnt, "ddd") <> "Sate" Then
EndDays = 1
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
EndDays = 1
Else
EndDays = 3
End If
Else
If Format(DateCnt, "ddd") <> "Sun" Then
EndDays = 1
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
EndDays = 1
Else
EndDays = 2
End If
End If
DateCnt = DateAdd("d", EndDays, DateCnt)
Next i
Debug.Print Format(DateCnt, "ddd") & " " & DateCnt
If intType = 1 Then
If Format(DateCnt, "ddd") = "Sat" Then
DateCnt = DateAdd("d", 2, DateCnt)
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
DateCnt = DateAdd("d", 1, DateCnt)
End If
Else
If Format(DateCnt, "ddd") = "Sun" Then
DateCnt = DateAdd("d", 1, DateCnt)
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
DateCnt = DateAdd("d", 1, DateCnt)
End If
End If
If intType = 1 Then
Do Until Format(DateCnt, "ddd") <> "Sat" And _
Format(DateCnt, "ddd") <> "Sun" And _
Not IsNull(DLookup("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt))) = False
DateCnt = DateAdd("d", 1, DateCnt)
Loop
Else
Do Until Format(DateCnt, "ddd") = "Sun" And _
Not IsNull(DLookup("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt))) = False
DateCnt = DateAdd("d", 1, DateCnt)
Loop
End If
MyDeadLine = DateCnt
End Function
ไม่ทราบว่ามีตาราง holidays หรือเปล่าครับ
ถ้ามีให้ทดสอบดังนี้
? MyDeadLine(#10/Apr/2002#,1,3)
Sat 13/4/2545
16/4/2545
วันที่ 10 เม.ย. 2545 เป็นวันพุธ
วันที่ 13-15 เม.ย. เป็นวันหยุด
6 @R01609
ผมได้นำตัวอย่างไปประยุกต์ใช้ปรากฎ ได้ผลดีมากครับ ขอบคุณสำหรับคำชี้แนะครับ
7 @R01610
ผมเจอบักอยู่หลายส่วน
ให้ใช้ตัวนี้แทนครับ
Function MyDeadLine(BegDate As Variant, intType As Integer, intDays As Integer) As Date
Dim i As Integer, intHolidays As Integer
Dim DateCnt As Variant, intCountDown As Integer
Dim EndDays As Integer
BegDate = DateValue(BegDate)
EndDays = 0
DateCnt = BegDate
intCountDown = 0
Do While intCountDown <> intDays
If intType = 1 Then
If Format(DateCnt, "ddd") = "Sat" Then
EndDays = 2
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
EndDays = 1
Else
EndDays = 1
intCountDown = intCountDown + 1
End If
Else
If Format(DateCnt, "ddd") = "Sun" Then
EndDays = 1
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
EndDays = 1
Else
EndDays = 1
intCountDown = intCountDown + 1
End If
End If
Debug.Print intCountDown & " " & Format(DateCnt, "ddd") & " " & DateCnt & " --> " & EndDays
DateCnt = DateAdd("d", EndDays, DateCnt)
Loop
Debug.Print Format(DateCnt, "ddd") & " " & DateCnt
If intType = 1 Then
If Format(DateCnt, "ddd") = "Sat" Then
DateCnt = DateAdd("d", 2, DateCnt)
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
DateCnt = DateAdd("d", 1, DateCnt)
End If
Else
If Format(DateCnt, "ddd") = "Sun" Then
DateCnt = DateAdd("d", 1, DateCnt)
ElseIf DCount("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt)) Then
DateCnt = DateAdd("d", 1, DateCnt)
End If
End If
Debug.Print "Loop 2 --> " & Format(DateCnt, "ddd") & " " & DateCnt
intCountDown = 0
If intType = 1 Then
Do Until Format(DateCnt, "ddd") <> "Sat" And _
Format(DateCnt, "ddd") <> "Sun" And _
Not IsNull(DLookup("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt))) = False
DateCnt = DateAdd("d", 1, DateCnt)
intCountDown = intCountDown + 1
Debug.Print intCountDown & " " & Format(DateCnt, "ddd") & " " & DateCnt
Loop
Else
Do Until Format(DateCnt, "ddd") <> "Sun" And _
Not IsNull(DLookup("holidays", "tblholidays", "Cdbl([holidays])= " & CDbl(DateCnt))) = False
DateCnt = DateAdd("d", 1, DateCnt)
intCountDown = intCountDown + 1
Debug.Print intCountDown & " " & Format(DateCnt, "ddd") & " " & DateCnt
Loop
End If
MyDeadLine = DateCnt
End Function
เผื่อใครนำไปใช้แล้วเจอบักอีก ให้ช่วยแจ้งเข้ามาด้วยครับ
8 @R01613
ขอรบกวน อ. สุภาพ เพิ่มครับ คือว่า จาก Weboard ที่ผ่านมา อ. จะมีตัวอย่างให้ D/L ไปดูด้วย ตัวอย่างนี้ก็ขอรบกวนอาจารย์ทำตัวอย่างให้ดูด้วยนะครับ แบบว่าผมใช้โมดูลไม่เป็นครับ
9 @R01614
ตัวอย่างอยู่ที่ http://agserver.kku.ac.th/basiceng/datetime_deadline.zip
แต่ยังมีบักอยู่ครับ ให้เอาตัวที่แก้ไขล่าสุดข้างบนไปเขียนทับลงไปแทนฟังก์ชันเดิมครับ
10 @R01625
เห็นอาจารย์ ใช้คำสั่ง แบบนี้อยู่ในหลายตัวอย่าง มันคืออะไรครับ แล้วเป็นอย่างไรครับ
? MyDeadLine(#10/Apr/2002#,1,3)
Sat 13/4/2545
16/4/2545
Time: 0.1343s