กระทู้เก่าบอร์ด อ.Yeadram
3,406 11
URL.หัวข้อ /
URL
รันเลขที่ใบเสร็จ
มีเรื่องรบกวนค่ะ (อีกแล้วค่ะ)
โจทย์
1.ต้องการรันเลขที่ใบเสร็จ โดย มี เล่มที่
และเลขที่
เช่น เล่ม 200 เลขที่ 001 ให้เลขที่ รันออโต้ แล้วให้เลขถึง 500
พอเล่มที่ เปลี่ยน
เลขที่ต้องกลับมาเริ่มนับ 1 ใหม่ ต้องทำยังไงค่ะ คือ มือใหม่หัดเขียน ค่ะ
โจทย์
1.ต้องการรันเลขที่ใบเสร็จ โดย มี เล่มที่
และเลขที่
เช่น เล่ม 200 เลขที่ 001 ให้เลขที่ รันออโต้ แล้วให้เลขถึง 500
พอเล่มที่ เปลี่ยน
เลขที่ต้องกลับมาเริ่มนับ 1 ใหม่ ต้องทำยังไงค่ะ คือ มือใหม่หัดเขียน ค่ะ
11 Reply in this Topic. Dispaly 1 pages and you are on page number 1
2 @R24002
มีคนบอกว่าเลขที่ใบเสร็จแบบนี้ทำไม่ กังวลมากเลยค่ะ
3 @R24003
จริงๆ การทำแบบนี้ทำได้หลายวิธีครับ ขึ้นอยู่กับว่าฐานข้อมูลเรคคอร์ดมีการลบด้วยหรือไม่ ถ้าจะทำแบบรัดกุมก็อาจจะต้องทำกันหลายขั้นตอน แต่ถ้าแบบไม่ยุ่งยากมากก็แบบนี้ครับ
VDO
VDO
4 @R24005
ขอบคุณ คุณ TTT ด้วยนะคะ ทำตามวีดีโอแล้วได้เลขที่ใบเสร็จมาเรียบร้อยแล้วค่ะ ^_^
5 @R24006
มีอีโจทย์มารบกวนอีกแล้วค่ะ เกี่ยวกับ เลขที่ใบเสร็จค่ะ
โจทย์
ต้องการค้นหา เล่มที่ ใบเสร็จ เลขที่ ในวันที่ ถึง วันที่ ชื่อเจ้าหน้าที่
เงื่อนไข
1.1 เลือกวันที่ 08/09/60
1.2 เลือก เล่มที่ ใบเสร็จ 001
1.3 เลือก เลขที่ใบเสร็จตั้งแต่เลขที่ 001-100
1.4 เลือก ชื่อเจ้าหน้าที่ น.ส หน้าสิว เต็มหน้า
ต้องทำยังไงค่ะ เงื่อนไขเยอะมาก มือใหม่หนักมากค่ะ
โจทย์
ต้องการค้นหา เล่มที่ ใบเสร็จ เลขที่ ในวันที่ ถึง วันที่ ชื่อเจ้าหน้าที่
เงื่อนไข
1.1 เลือกวันที่ 08/09/60
1.2 เลือก เล่มที่ ใบเสร็จ 001
1.3 เลือก เลขที่ใบเสร็จตั้งแต่เลขที่ 001-100
1.4 เลือก ชื่อเจ้าหน้าที่ น.ส หน้าสิว เต็มหน้า
ต้องทำยังไงค่ะ เงื่อนไขเยอะมาก มือใหม่หนักมากค่ะ
6 @R24008
ลองปรับใช้ดูตามไฟล์ตัวอย่างครับ
มีปัญหาตรงที่ช่องวันที่กับช่องเลขที่บังคับใส่ครับ ถ้าไม่ใส่มันจะค้นหาไม่เจอ อ.TTT พอจะมีวิธีแนะนำไหมครับถ้าหากผู้ใช้ต้องการค้นหาเฉพาะชื่อโดยไม่ทราบวันที่หรือเลขที่ต้องแก้ที่ตรงไหน
https://drive.google.com/open?id=0BwzAwbv8tImLNzBjREw2MHBwUkk
มีปัญหาตรงที่ช่องวันที่กับช่องเลขที่บังคับใส่ครับ ถ้าไม่ใส่มันจะค้นหาไม่เจอ อ.TTT พอจะมีวิธีแนะนำไหมครับถ้าหากผู้ใช้ต้องการค้นหาเฉพาะชื่อโดยไม่ทราบวันที่หรือเลขที่ต้องแก้ที่ตรงไหน
https://drive.google.com/open?id=0BwzAwbv8tImLNzBjREw2MHBwUkk

7 @R24016
ทำได้เรียบร้อยแล้วค่ะ ขอบคุณพี่ๆและอาจารย์ทุกท่านนะคะ ^-^
8 @R24017
มีเรื่องรบกวน 2 เรื่องค่ะ
1.ในส่วนของ report ตรงรายงาน จำนวนเลขที่ ใบเสร็จ จะรายตรงหัวว่า ตั้งแต่เลขที่ ถึง เลขที่
เช่น รายงานเล่มที่ 003 เลขที่ 001 ถึงเลขที่ 005 ต้องใช้คำสั่งหรือดค้ดอะไรค่ะ ตอนนี้ทำได้แค่ที่ส่งตัวอย่างให้ดูค่ะ
2.ในหัวข้อ ตัวอักษร เรืือกโมดู battext ไม่ออกมาเป็นภาษาไทย แต่ออกมาเป้นภาษาต่างด้าว ต้อวเข้าไปแก้ไขตรงไหนค่ะ

มีเรื่องรบกวน 2 เรื่องค่ะ
1.ในส่วนของ report ตรงรายงาน จำนวนเลขที่ ใบเสร็จ จะรายตรงหัวว่า ตั้งแต่เลขที่ ถึง เลขที่
เช่น รายงานเล่มที่ 003 เลขที่ 001 ถึงเลขที่ 005 ต้องใช้คำสั่งหรือดค้ดอะไรค่ะ ตอนนี้ทำได้แค่ที่ส่งตัวอย่างให้ดูค่ะ
2.ในหัวข้อ ตัวอักษร เรืือกโมดู battext ไม่ออกมาเป็นภาษาไทย แต่ออกมาเป้นภาษาต่างด้าว ต้อวเข้าไปแก้ไขตรงไหนค่ะ
9 @R24024
1.ในTextboxของรายงาน ให้อ้างอิงแหล่งที่มาเหมือนกับในQuery คือ=Forms![ชื่อฟอร์ม]!ชื่อTextbox ตัวอย่างเช่น
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.หมายถึงคำสั่งเปลียนตัวเลขเป็นตัวอักษรใช่หรือไม่ครับ ถ้าใช่ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
1.ในTextboxของรายงาน ให้อ้างอิงแหล่งที่มาเหมือนกับในQuery คือ=Forms![ชื่อฟอร์ม]!ชื่อTextbox ตัวอย่างเช่น
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
และสร้างมาโครโดยใช้คำสั่งดังนี้ครับ
Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------------------------------------------
' Function: BahtText
' Purpose: converts a number to a string that spells out the number in Thai
'-------------------------------------------------------------------------------------------------------------------------
Function BahtText(InputCurrency As Currency) As String
Dim DigitSave, UnitSave, DigitName, DigitName1, UnitName, Satang, StrTmp, StrTmp1 As String
Dim DecimalValue, CurrDigit, PrevDigit, StrLen, DigitBase, ScanDigit As Integer
Dim IntegerValue As Double
' init variable
DigitName = "ศูนย์หนึ่งสอง สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number
DigitName1 = " ยี่ สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number in another call
UnitName = "แสน ล้าน สิบ ร้อย พัน หมื่น" ' name of digit base
BahtText = ""
Satang = ""
' check for negative val
If InputCurrency < 0 Then
InputCurrency = -InputCurrency
BahtText = "ลบ"
End If
StrTmp1 = Format(InputCurrency, "0.00") ' rounds up to 2 decimals
InputCurrency = Val(StrTmp1)
IntegerValue = Int(InputCurrency) ' get integer value
DecimalValue = (InputCurrency - IntegerValue) * 100 ' get 2 decimal values
' check for zeto val
If IntegerValue = 0 And DecimalValue = 0 Then
Satang = "ศูนย์บาทถ้วน"
GoTo locExit
End If
' translate integer val to name if necesary
If IntegerValue > 0 Then
StrTmp = Left(StrTmp1, Len(StrTmp1) - 3) ' get string of integer val
StrLen = Len(StrTmp) ' get string len
CurrDigit = 0
' scan integer string and compute its name
For ScanDigit = StrLen To 1 Step -1
' save previous digit
PrevDigit = CurrDigit
' get digit base
DigitBase = ScanDigit Mod 6
' convert digit character to numeric value
CurrDigit = Asc(Mid(StrTmp, StrLen - ScanDigit + 1, 1)) - 48
' get unit name from its base
UnitSave = RTrim(Mid(UnitName, DigitBase * 5 + 1, 5))
' get number name from Currdigit, depends on the digit base
DigitSave = RTrim(Mid(IIf(DigitBase = 2, DigitName1, DigitName), CurrDigit * 5 + 1, 5))
' base ten and number 1
If DigitBase = 1 And CurrDigit = 1 And PrevDigit <> 0 Then
DigitSave = "เอ็ด"
End If
' first digit base may be base million or 1
If DigitBase = 1 And ScanDigit < 6 Then
UnitSave = ""
End If
' ignore add digit name in result string if it is zero
If CurrDigit <> 0 Then
BahtText = BahtText + DigitSave + UnitSave
ElseIf DigitBase = 1 Then
BahtText = BahtText + UnitSave
End If
Next ScanDigit
BahtText = BahtText + "บาท"
End If
' if no decimal value
If DecimalValue = 0 Then
Satang = "ถ้วน"
' compute decimal val to name, there are only 2 digit
Else
StrTmp = Right(StrTmp1, 2)
' name ot first digit
CurrDigit = Asc(Left(StrTmp, 1)) - 48
PrevDigit = CurrDigit
If CurrDigit > 0 Then
Satang = RTrim(Mid(DigitName1, CurrDigit * 5 + 1, 5)) + "สิบ"
End If
' name of last digit
CurrDigit = Asc(Right(StrTmp, 1)) - 48
If CurrDigit > 0 Then
Satang = Satang + IIf(CurrDigit = 1 And PrevDigit <> 0, "เอ็ด", RTrim(Mid(DigitName, CurrDigit * 5 + 1, 5)))
End If
' store result and unit
Satang = Satang + "สตางค์"
End If
locExit:
' store result to BahtText
BahtText = BahtText + Satang
End Function
'----------------------------------------------------------------------------------------------------------------------------------
' Function: TLeft
' Purpose: Returns a specified number of Thai cells from the left side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TLeft(InputString As String, CellLength As Integer) As Variant
TLeft = Left(InputString, TCell2Count(InputString, CellLength, 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TRight
' Purpose: Returns a specified number of Thai cells from the right side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TRight(InputString As String, CellLength As Integer) As Variant
TRight = Right(InputString, TCell2Count(InputString, CellLength, TCell2Count(InputString, TLen(InputString) - CellLength, 1, False) + 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TMid
' Purpose: Returns a specified number of Thai cells from a string.
'----------------------------------------------------------------------------------------------------------------------------------
Function TMid(InputString As String, ChopCell As Integer, ChopLength As Integer) As Variant
Dim StartChopByte As Integer
' validate parameter range
ChopCell = max(ChopCell, 0)
ChopLength = max(ChopLength, 0)
' get start byte form requested cell
StartChopByte = TCell2Count(InputString, ChopCell, 1, True)
' get sub-string by Mid()
TMid = Mid(InputString, StartChopByte, TCell2Count(InputString, ChopLength, StartChopByte, False))
End Function
'----------------------------------------------------------------------------------------------------------------------
' Function: TStr
' Purpose: Returns a Thai string representation of a number.
'----------------------------------------------------------------------------------------------------------------------
Function TStr(InputNumber As Variant) As Variant
Dim StringLength, StringScan As Integer
Dim ch As String
TStr = Str(InputNumber)
StringLength = Len(TStr)
For StringScan = 1 To StringLength
ch = Mid(TStr, StringScan, 1)
If (ch >= "0" And ch <= "9") Then
Mid$(TStr, StringScan, 1) = Chr(Asc(ch) + 192)
End If
Next StringScan
End Function
'---------------------------------------------------------------------------------------
' Function: TLen
' Purpose: Returns the number of Thai cells in a string
'---------------------------------------------------------------------------------------
Function TLen(InputString As String) As Integer
Dim StringLength, StringScan As Integer
StringLength = Len(InputString)
TLen = 0
For StringScan = 1 To StringLength
If Not IsZeroWidthChar(Asc(Mid(InputString, StringScan, 1))) Then
TLen = TLen + 1
End If
Next StringScan
End Function
'----------------------------------------------------------------------------------------------------------------
' Internal function: computes the maximum value between p1 and p2
'----------------------------------------------------------------------------------------------------------------
Function max(p1 As Variant, p2 As Variant) As Variant
If p1 > p2 Then
max = p1
Else
max = p2
End If
End Function
'------------------------------------------------------------------------
' Internal function: IsZeroWidthChar
'------------------------------------------------------------------------
Function IsZeroWidthChar(ch As Integer) As Integer
IsZeroWidthChar = (ch = 209) Or (ch > 211 And ch < 219) Or (ch > 230 And ch < 239)
End Function
'-----------------------------------------------------------------------------------------------------------------
' Internal function: TCell2Count counts the number of bytes in Thai cells
'-----------------------------------------------------------------------------------------------------------------
Function TCell2Count(StringInput As String, CellLength As Integer, StartScan As Integer, SWMode As Integer) As Integer
Dim StringInputLength, CellCount As Integer
StringInputLength = Len(StringInput)
CellCount = 0
TCell2Count = 0
StartScan = max(StartScan, 1)
CellLength = max(CellLength, 0)
While TCell2Count + StartScan <= StringInputLength And CellCount <> CellLength
If Not IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
CellCount = CellCount + 1
End If
TCell2Count = TCell2Count + 1
Wend
If Not SWMode Then
While TCell2Count + StartScan <= StringInputLength
If IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
TCell2Count = TCell2Count + 1
Else
GoTo locExit
End If
Wend
End If
locExit:
End Function
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.หมายถึงคำสั่งเปลียนตัวเลขเป็นตัวอักษรใช่หรือไม่ครับ ถ้าใช่ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
1.ในTextboxของรายงาน ให้อ้างอิงแหล่งที่มาเหมือนกับในQuery คือ=Forms![ชื่อฟอร์ม]!ชื่อTextbox ตัวอย่างเช่น
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
และสร้างมาโครโดยใช้คำสั่งดังนี้ครับ
Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------------------------------------------
' Function: BahtText
' Purpose: converts a number to a string that spells out the number in Thai
'-------------------------------------------------------------------------------------------------------------------------
Function BahtText(InputCurrency As Currency) As String
Dim DigitSave, UnitSave, DigitName, DigitName1, UnitName, Satang, StrTmp, StrTmp1 As String
Dim DecimalValue, CurrDigit, PrevDigit, StrLen, DigitBase, ScanDigit As Integer
Dim IntegerValue As Double
' init variable
DigitName = "ศูนย์หนึ่งสอง สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number
DigitName1 = " ยี่ สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number in another call
UnitName = "แสน ล้าน สิบ ร้อย พัน หมื่น" ' name of digit base
BahtText = ""
Satang = ""
' check for negative val
If InputCurrency < 0 Then
InputCurrency = -InputCurrency
BahtText = "ลบ"
End If
StrTmp1 = Format(InputCurrency, "0.00") ' rounds up to 2 decimals
InputCurrency = Val(StrTmp1)
IntegerValue = Int(InputCurrency) ' get integer value
DecimalValue = (InputCurrency - IntegerValue) * 100 ' get 2 decimal values
' check for zeto val
If IntegerValue = 0 And DecimalValue = 0 Then
Satang = "ศูนย์บาทถ้วน"
GoTo locExit
End If
' translate integer val to name if necesary
If IntegerValue > 0 Then
StrTmp = Left(StrTmp1, Len(StrTmp1) - 3) ' get string of integer val
StrLen = Len(StrTmp) ' get string len
CurrDigit = 0
' scan integer string and compute its name
For ScanDigit = StrLen To 1 Step -1
' save previous digit
PrevDigit = CurrDigit
' get digit base
DigitBase = ScanDigit Mod 6
' convert digit character to numeric value
CurrDigit = Asc(Mid(StrTmp, StrLen - ScanDigit + 1, 1)) - 48
' get unit name from its base
UnitSave = RTrim(Mid(UnitName, DigitBase * 5 + 1, 5))
' get number name from Currdigit, depends on the digit base
DigitSave = RTrim(Mid(IIf(DigitBase = 2, DigitName1, DigitName), CurrDigit * 5 + 1, 5))
' base ten and number 1
If DigitBase = 1 And CurrDigit = 1 And PrevDigit <> 0 Then
DigitSave = "เอ็ด"
End If
' first digit base may be base million or 1
If DigitBase = 1 And ScanDigit < 6 Then
UnitSave = ""
End If
' ignore add digit name in result string if it is zero
If CurrDigit <> 0 Then
BahtText = BahtText + DigitSave + UnitSave
ElseIf DigitBase = 1 Then
BahtText = BahtText + UnitSave
End If
Next ScanDigit
BahtText = BahtText + "บาท"
End If
' if no decimal value
If DecimalValue = 0 Then
Satang = "ถ้วน"
' compute decimal val to name, there are only 2 digit
Else
StrTmp = Right(StrTmp1, 2)
' name ot first digit
CurrDigit = Asc(Left(StrTmp, 1)) - 48
PrevDigit = CurrDigit
If CurrDigit > 0 Then
Satang = RTrim(Mid(DigitName1, CurrDigit * 5 + 1, 5)) + "สิบ"
End If
' name of last digit
CurrDigit = Asc(Right(StrTmp, 1)) - 48
If CurrDigit > 0 Then
Satang = Satang + IIf(CurrDigit = 1 And PrevDigit <> 0, "เอ็ด", RTrim(Mid(DigitName, CurrDigit * 5 + 1, 5)))
End If
' store result and unit
Satang = Satang + "สตางค์"
End If
locExit:
' store result to BahtText
BahtText = BahtText + Satang
End Function
'----------------------------------------------------------------------------------------------------------------------------------
' Function: TLeft
' Purpose: Returns a specified number of Thai cells from the left side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TLeft(InputString As String, CellLength As Integer) As Variant
TLeft = Left(InputString, TCell2Count(InputString, CellLength, 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TRight
' Purpose: Returns a specified number of Thai cells from the right side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TRight(InputString As String, CellLength As Integer) As Variant
TRight = Right(InputString, TCell2Count(InputString, CellLength, TCell2Count(InputString, TLen(InputString) - CellLength, 1, False) + 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TMid
' Purpose: Returns a specified number of Thai cells from a string.
'----------------------------------------------------------------------------------------------------------------------------------
Function TMid(InputString As String, ChopCell As Integer, ChopLength As Integer) As Variant
Dim StartChopByte As Integer
' validate parameter range
ChopCell = max(ChopCell, 0)
ChopLength = max(ChopLength, 0)
' get start byte form requested cell
StartChopByte = TCell2Count(InputString, ChopCell, 1, True)
' get sub-string by Mid()
TMid = Mid(InputString, StartChopByte, TCell2Count(InputString, ChopLength, StartChopByte, False))
End Function
'----------------------------------------------------------------------------------------------------------------------
' Function: TStr
' Purpose: Returns a Thai string representation of a number.
'----------------------------------------------------------------------------------------------------------------------
Function TStr(InputNumber As Variant) As Variant
Dim StringLength, StringScan As Integer
Dim ch As String
TStr = Str(InputNumber)
StringLength = Len(TStr)
For StringScan = 1 To StringLength
ch = Mid(TStr, StringScan, 1)
If (ch >= "0" And ch <= "9") Then
Mid$(TStr, StringScan, 1) = Chr(Asc(ch) + 192)
End If
Next StringScan
End Function
'---------------------------------------------------------------------------------------
' Function: TLen
' Purpose: Returns the number of Thai cells in a string
'---------------------------------------------------------------------------------------
Function TLen(InputString As String) As Integer
Dim StringLength, StringScan As Integer
StringLength = Len(InputString)
TLen = 0
For StringScan = 1 To StringLength
If Not IsZeroWidthChar(Asc(Mid(InputString, StringScan, 1))) Then
TLen = TLen + 1
End If
Next StringScan
End Function
'----------------------------------------------------------------------------------------------------------------
' Internal function: computes the maximum value between p1 and p2
'----------------------------------------------------------------------------------------------------------------
Function max(p1 As Variant, p2 As Variant) As Variant
If p1 > p2 Then
max = p1
Else
max = p2
End If
End Function
'------------------------------------------------------------------------
' Internal function: IsZeroWidthChar
'------------------------------------------------------------------------
Function IsZeroWidthChar(ch As Integer) As Integer
IsZeroWidthChar = (ch = 209) Or (ch > 211 And ch < 219) Or (ch > 230 And ch < 239)
End Function
'-----------------------------------------------------------------------------------------------------------------
' Internal function: TCell2Count counts the number of bytes in Thai cells
'-----------------------------------------------------------------------------------------------------------------
Function TCell2Count(StringInput As String, CellLength As Integer, StartScan As Integer, SWMode As Integer) As Integer
Dim StringInputLength, CellCount As Integer
StringInputLength = Len(StringInput)
CellCount = 0
TCell2Count = 0
StartScan = max(StartScan, 1)
CellLength = max(CellLength, 0)
While TCell2Count + StartScan <= StringInputLength And CellCount <> CellLength
If Not IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
CellCount = CellCount + 1
End If
TCell2Count = TCell2Count + 1
Wend
If Not SWMode Then
While TCell2Count + StartScan <= StringInputLength
If IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
TCell2Count = TCell2Count + 1
Else
GoTo locExit
End If
Wend
End If
locExit:
End Function
10 @R24025
ขอโทษครับ COPYซ้ำไปซ้ำมาครับ เอาตามนี้ครับ
1.ในTextboxของรายงาน ให้อ้างอิงแหล่งที่มาเหมือนกับในQuery คือ=Forms![ชื่อฟอร์ม]!ชื่อTextbox ตัวอย่างเช่น
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.หมายถึงคำสั่งเปลียนตัวเลขเป็นตัวอักษรใช่หรือไม่ครับ ถ้าใช่ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
และสร้างมาโครโดยใช้คำสั่งดังนี้ครับ
Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------------------------------------------
' Function: BahtText
' Purpose: converts a number to a string that spells out the number in Thai
'-------------------------------------------------------------------------------------------------------------------------
Function BahtText(InputCurrency As Currency) As String
Dim DigitSave, UnitSave, DigitName, DigitName1, UnitName, Satang, StrTmp, StrTmp1 As String
Dim DecimalValue, CurrDigit, PrevDigit, StrLen, DigitBase, ScanDigit As Integer
Dim IntegerValue As Double
' init variable
DigitName = "ศูนย์หนึ่งสอง สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number
DigitName1 = " ยี่ สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number in another call
UnitName = "แสน ล้าน สิบ ร้อย พัน หมื่น" ' name of digit base
BahtText = ""
Satang = ""
' check for negative val
If InputCurrency < 0 Then
InputCurrency = -InputCurrency
BahtText = "ลบ"
End If
StrTmp1 = Format(InputCurrency, "0.00") ' rounds up to 2 decimals
InputCurrency = Val(StrTmp1)
IntegerValue = Int(InputCurrency) ' get integer value
DecimalValue = (InputCurrency - IntegerValue) * 100 ' get 2 decimal values
' check for zeto val
If IntegerValue = 0 And DecimalValue = 0 Then
Satang = "ศูนย์บาทถ้วน"
GoTo locExit
End If
' translate integer val to name if necesary
If IntegerValue > 0 Then
StrTmp = Left(StrTmp1, Len(StrTmp1) - 3) ' get string of integer val
StrLen = Len(StrTmp) ' get string len
CurrDigit = 0
' scan integer string and compute its name
For ScanDigit = StrLen To 1 Step -1
' save previous digit
PrevDigit = CurrDigit
' get digit base
DigitBase = ScanDigit Mod 6
' convert digit character to numeric value
CurrDigit = Asc(Mid(StrTmp, StrLen - ScanDigit + 1, 1)) - 48
' get unit name from its base
UnitSave = RTrim(Mid(UnitName, DigitBase * 5 + 1, 5))
' get number name from Currdigit, depends on the digit base
DigitSave = RTrim(Mid(IIf(DigitBase = 2, DigitName1, DigitName), CurrDigit * 5 + 1, 5))
' base ten and number 1
If DigitBase = 1 And CurrDigit = 1 And PrevDigit <> 0 Then
DigitSave = "เอ็ด"
End If
' first digit base may be base million or 1
If DigitBase = 1 And ScanDigit < 6 Then
UnitSave = ""
End If
' ignore add digit name in result string if it is zero
If CurrDigit <> 0 Then
BahtText = BahtText + DigitSave + UnitSave
ElseIf DigitBase = 1 Then
BahtText = BahtText + UnitSave
End If
Next ScanDigit
BahtText = BahtText + "บาท"
End If
' if no decimal value
If DecimalValue = 0 Then
Satang = "ถ้วน"
' compute decimal val to name, there are only 2 digit
Else
StrTmp = Right(StrTmp1, 2)
' name ot first digit
CurrDigit = Asc(Left(StrTmp, 1)) - 48
PrevDigit = CurrDigit
If CurrDigit > 0 Then
Satang = RTrim(Mid(DigitName1, CurrDigit * 5 + 1, 5)) + "สิบ"
End If
' name of last digit
CurrDigit = Asc(Right(StrTmp, 1)) - 48
If CurrDigit > 0 Then
Satang = Satang + IIf(CurrDigit = 1 And PrevDigit <> 0, "เอ็ด", RTrim(Mid(DigitName, CurrDigit * 5 + 1, 5)))
End If
' store result and unit
Satang = Satang + "สตางค์"
End If
locExit:
' store result to BahtText
BahtText = BahtText + Satang
End Function
'----------------------------------------------------------------------------------------------------------------------------------
' Function: TLeft
' Purpose: Returns a specified number of Thai cells from the left side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TLeft(InputString As String, CellLength As Integer) As Variant
TLeft = Left(InputString, TCell2Count(InputString, CellLength, 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TRight
' Purpose: Returns a specified number of Thai cells from the right side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TRight(InputString As String, CellLength As Integer) As Variant
TRight = Right(InputString, TCell2Count(InputString, CellLength, TCell2Count(InputString, TLen(InputString) - CellLength, 1, False) + 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TMid
' Purpose: Returns a specified number of Thai cells from a string.
'----------------------------------------------------------------------------------------------------------------------------------
Function TMid(InputString As String, ChopCell As Integer, ChopLength As Integer) As Variant
Dim StartChopByte As Integer
' validate parameter range
ChopCell = max(ChopCell, 0)
ChopLength = max(ChopLength, 0)
' get start byte form requested cell
StartChopByte = TCell2Count(InputString, ChopCell, 1, True)
' get sub-string by Mid()
TMid = Mid(InputString, StartChopByte, TCell2Count(InputString, ChopLength, StartChopByte, False))
End Function
'----------------------------------------------------------------------------------------------------------------------
' Function: TStr
' Purpose: Returns a Thai string representation of a number.
'----------------------------------------------------------------------------------------------------------------------
Function TStr(InputNumber As Variant) As Variant
Dim StringLength, StringScan As Integer
Dim ch As String
TStr = Str(InputNumber)
StringLength = Len(TStr)
For StringScan = 1 To StringLength
ch = Mid(TStr, StringScan, 1)
If (ch >= "0" And ch <= "9") Then
Mid$(TStr, StringScan, 1) = Chr(Asc(ch) + 192)
End If
Next StringScan
End Function
'---------------------------------------------------------------------------------------
' Function: TLen
' Purpose: Returns the number of Thai cells in a string
'---------------------------------------------------------------------------------------
Function TLen(InputString As String) As Integer
Dim StringLength, StringScan As Integer
StringLength = Len(InputString)
TLen = 0
For StringScan = 1 To StringLength
If Not IsZeroWidthChar(Asc(Mid(InputString, StringScan, 1))) Then
TLen = TLen + 1
End If
Next StringScan
End Function
'----------------------------------------------------------------------------------------------------------------
' Internal function: computes the maximum value between p1 and p2
'----------------------------------------------------------------------------------------------------------------
Function max(p1 As Variant, p2 As Variant) As Variant
If p1 > p2 Then
max = p1
Else
max = p2
End If
End Function
'------------------------------------------------------------------------
' Internal function: IsZeroWidthChar
'------------------------------------------------------------------------
Function IsZeroWidthChar(ch As Integer) As Integer
IsZeroWidthChar = (ch = 209) Or (ch > 211 And ch < 219) Or (ch > 230 And ch < 239)
End Function
'-----------------------------------------------------------------------------------------------------------------
' Internal function: TCell2Count counts the number of bytes in Thai cells
'-----------------------------------------------------------------------------------------------------------------
Function TCell2Count(StringInput As String, CellLength As Integer, StartScan As Integer, SWMode As Integer) As Integer
Dim StringInputLength, CellCount As Integer
StringInputLength = Len(StringInput)
CellCount = 0
TCell2Count = 0
StartScan = max(StartScan, 1)
CellLength = max(CellLength, 0)
While TCell2Count + StartScan <= StringInputLength And CellCount <> CellLength
If Not IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
CellCount = CellCount + 1
End If
TCell2Count = TCell2Count + 1
Wend
If Not SWMode Then
While TCell2Count + StartScan <= StringInputLength
If IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
TCell2Count = TCell2Count + 1
Else
GoTo locExit
End If
Wend
End If
locExit:
End Function
1.ในTextboxของรายงาน ให้อ้างอิงแหล่งที่มาเหมือนกับในQuery คือ=Forms![ชื่อฟอร์ม]!ชื่อTextbox ตัวอย่างเช่น
Textbox ตั้่งแต่วันที่ ใช้ =Forms![ค้นหา]!BDate
Textbox ถึงวันที่ ใช้ =Forms![ค้นหา]!TDate
เป็นต้น
2.หมายถึงคำสั่งเปลียนตัวเลขเป็นตัวอักษรใช่หรือไม่ครับ ถ้าใช่ในTextboxที่ต้องการแสดงเป็นภาษาไทยกำหนดแหล่งข้อมูลเป็น
="( " & bahttext([Forms]![ชื่อฟอร์ม]![ชื่อTextboxที่เป็นตัวเลข]) & " )"
และสร้างมาโครโดยใช้คำสั่งดังนี้ครับ
Option Compare Database
Option Explicit
'-------------------------------------------------------------------------------------------------------------------------
' Function: BahtText
' Purpose: converts a number to a string that spells out the number in Thai
'-------------------------------------------------------------------------------------------------------------------------
Function BahtText(InputCurrency As Currency) As String
Dim DigitSave, UnitSave, DigitName, DigitName1, UnitName, Satang, StrTmp, StrTmp1 As String
Dim DecimalValue, CurrDigit, PrevDigit, StrLen, DigitBase, ScanDigit As Integer
Dim IntegerValue As Double
' init variable
DigitName = "ศูนย์หนึ่งสอง สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number
DigitName1 = " ยี่ สาม สี่ ห้า หก เจ็ด แปด เก้า " ' name of digit number in another call
UnitName = "แสน ล้าน สิบ ร้อย พัน หมื่น" ' name of digit base
BahtText = ""
Satang = ""
' check for negative val
If InputCurrency < 0 Then
InputCurrency = -InputCurrency
BahtText = "ลบ"
End If
StrTmp1 = Format(InputCurrency, "0.00") ' rounds up to 2 decimals
InputCurrency = Val(StrTmp1)
IntegerValue = Int(InputCurrency) ' get integer value
DecimalValue = (InputCurrency - IntegerValue) * 100 ' get 2 decimal values
' check for zeto val
If IntegerValue = 0 And DecimalValue = 0 Then
Satang = "ศูนย์บาทถ้วน"
GoTo locExit
End If
' translate integer val to name if necesary
If IntegerValue > 0 Then
StrTmp = Left(StrTmp1, Len(StrTmp1) - 3) ' get string of integer val
StrLen = Len(StrTmp) ' get string len
CurrDigit = 0
' scan integer string and compute its name
For ScanDigit = StrLen To 1 Step -1
' save previous digit
PrevDigit = CurrDigit
' get digit base
DigitBase = ScanDigit Mod 6
' convert digit character to numeric value
CurrDigit = Asc(Mid(StrTmp, StrLen - ScanDigit + 1, 1)) - 48
' get unit name from its base
UnitSave = RTrim(Mid(UnitName, DigitBase * 5 + 1, 5))
' get number name from Currdigit, depends on the digit base
DigitSave = RTrim(Mid(IIf(DigitBase = 2, DigitName1, DigitName), CurrDigit * 5 + 1, 5))
' base ten and number 1
If DigitBase = 1 And CurrDigit = 1 And PrevDigit <> 0 Then
DigitSave = "เอ็ด"
End If
' first digit base may be base million or 1
If DigitBase = 1 And ScanDigit < 6 Then
UnitSave = ""
End If
' ignore add digit name in result string if it is zero
If CurrDigit <> 0 Then
BahtText = BahtText + DigitSave + UnitSave
ElseIf DigitBase = 1 Then
BahtText = BahtText + UnitSave
End If
Next ScanDigit
BahtText = BahtText + "บาท"
End If
' if no decimal value
If DecimalValue = 0 Then
Satang = "ถ้วน"
' compute decimal val to name, there are only 2 digit
Else
StrTmp = Right(StrTmp1, 2)
' name ot first digit
CurrDigit = Asc(Left(StrTmp, 1)) - 48
PrevDigit = CurrDigit
If CurrDigit > 0 Then
Satang = RTrim(Mid(DigitName1, CurrDigit * 5 + 1, 5)) + "สิบ"
End If
' name of last digit
CurrDigit = Asc(Right(StrTmp, 1)) - 48
If CurrDigit > 0 Then
Satang = Satang + IIf(CurrDigit = 1 And PrevDigit <> 0, "เอ็ด", RTrim(Mid(DigitName, CurrDigit * 5 + 1, 5)))
End If
' store result and unit
Satang = Satang + "สตางค์"
End If
locExit:
' store result to BahtText
BahtText = BahtText + Satang
End Function
'----------------------------------------------------------------------------------------------------------------------------------
' Function: TLeft
' Purpose: Returns a specified number of Thai cells from the left side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TLeft(InputString As String, CellLength As Integer) As Variant
TLeft = Left(InputString, TCell2Count(InputString, CellLength, 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TRight
' Purpose: Returns a specified number of Thai cells from the right side of a string
'----------------------------------------------------------------------------------------------------------------------------------
Function TRight(InputString As String, CellLength As Integer) As Variant
TRight = Right(InputString, TCell2Count(InputString, CellLength, TCell2Count(InputString, TLen(InputString) - CellLength, 1, False) + 1, False))
End Function
'---------------------------------------------------------------------------------------------------------------------------------
' Function: TMid
' Purpose: Returns a specified number of Thai cells from a string.
'----------------------------------------------------------------------------------------------------------------------------------
Function TMid(InputString As String, ChopCell As Integer, ChopLength As Integer) As Variant
Dim StartChopByte As Integer
' validate parameter range
ChopCell = max(ChopCell, 0)
ChopLength = max(ChopLength, 0)
' get start byte form requested cell
StartChopByte = TCell2Count(InputString, ChopCell, 1, True)
' get sub-string by Mid()
TMid = Mid(InputString, StartChopByte, TCell2Count(InputString, ChopLength, StartChopByte, False))
End Function
'----------------------------------------------------------------------------------------------------------------------
' Function: TStr
' Purpose: Returns a Thai string representation of a number.
'----------------------------------------------------------------------------------------------------------------------
Function TStr(InputNumber As Variant) As Variant
Dim StringLength, StringScan As Integer
Dim ch As String
TStr = Str(InputNumber)
StringLength = Len(TStr)
For StringScan = 1 To StringLength
ch = Mid(TStr, StringScan, 1)
If (ch >= "0" And ch <= "9") Then
Mid$(TStr, StringScan, 1) = Chr(Asc(ch) + 192)
End If
Next StringScan
End Function
'---------------------------------------------------------------------------------------
' Function: TLen
' Purpose: Returns the number of Thai cells in a string
'---------------------------------------------------------------------------------------
Function TLen(InputString As String) As Integer
Dim StringLength, StringScan As Integer
StringLength = Len(InputString)
TLen = 0
For StringScan = 1 To StringLength
If Not IsZeroWidthChar(Asc(Mid(InputString, StringScan, 1))) Then
TLen = TLen + 1
End If
Next StringScan
End Function
'----------------------------------------------------------------------------------------------------------------
' Internal function: computes the maximum value between p1 and p2
'----------------------------------------------------------------------------------------------------------------
Function max(p1 As Variant, p2 As Variant) As Variant
If p1 > p2 Then
max = p1
Else
max = p2
End If
End Function
'------------------------------------------------------------------------
' Internal function: IsZeroWidthChar
'------------------------------------------------------------------------
Function IsZeroWidthChar(ch As Integer) As Integer
IsZeroWidthChar = (ch = 209) Or (ch > 211 And ch < 219) Or (ch > 230 And ch < 239)
End Function
'-----------------------------------------------------------------------------------------------------------------
' Internal function: TCell2Count counts the number of bytes in Thai cells
'-----------------------------------------------------------------------------------------------------------------
Function TCell2Count(StringInput As String, CellLength As Integer, StartScan As Integer, SWMode As Integer) As Integer
Dim StringInputLength, CellCount As Integer
StringInputLength = Len(StringInput)
CellCount = 0
TCell2Count = 0
StartScan = max(StartScan, 1)
CellLength = max(CellLength, 0)
While TCell2Count + StartScan <= StringInputLength And CellCount <> CellLength
If Not IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
CellCount = CellCount + 1
End If
TCell2Count = TCell2Count + 1
Wend
If Not SWMode Then
While TCell2Count + StartScan <= StringInputLength
If IsZeroWidthChar(Asc(Mid(StringInput, TCell2Count + StartScan, 1))) Then
TCell2Count = TCell2Count + 1
Else
GoTo locExit
End If
Wend
End If
locExit:
End Function
11 @R24037
ขอบคุณมากค่ะ^_^
Time: 0.6468s
http://www.thai-access.com/yeadram_view.php?topic_id=1705