การแปลงตัวเลขให้เป็นตัวหนังสือ (บาท) ใน Microsoft Word

       โดยปกติแล้วใน Excel จะมีฟังก์ชั่น BahtText() ที่ใช้สำหรับแปลงตัวเลขให้เ็้ป็นตัวหนังสือ (บาท) 
แต่ใน Word จะไม่มี ต้องพิมพ์จำนวนเงินให้เป็นตัวอักษรบ่อยใน Word
เราลองมาดูเขียน VBA เพื่อแปลงตัวเลขให้เป็นตัวหนังสือ (บาท) ว่าทำอย่างไร

Code ของโปรแกรมนะครับ

Sub B2Text()
'
Dim str1 As String, str2 As String
Dim SelInput As String
Dim LnText As Integer, pDot As Byte
Dim nLoop As Integer
Dim n As Integer, m As Integer
Dim sTemp1 As String, sTemp2 As String
Dim SpText As String
Dim bt1 As String, bt2 As String

On Error Resume Next

SelInput = Format(Trim(Selection.Text), "#.00") ' ตั้งค่าตัวเลขที่เลือกไว้ให้อยู่ในรูปแบบ "#.00" เป็นจุดทศนิยม 2 ตำแหน่ง

' ตรวจสอบว่าเป็นจำนวนที่เป็นตัวเลขหรือไม่
If IsNumeric(SelInput) Then
Else
MsgBox "โปรดเลือกเฉพาะตัวเลข", vbCritical, "Error"
Exit Sub
End If

LnText = Len(SelInput) ' หาความยาวของตัวเลขที่เลือก
pDot = InStr(SelInput, ".") ' หาตำแหน่งของ "."
str1 = Left(SelInput, pDot - 1) ' แยกตัวเลขที่อยู่หน้าจุดทศนิยม
str2 = Right(SelInput, LnText - pDot) ' แยกจำนวนตัวเลขหลังจุดทศนิยม

' แบ่งตัวเลขชุดหน้าจุดทศนิยมเป็น 6 หลัก nLoop เป็นจำนวนชุดของตัวเลข (6 มาจากจำนวนหลัก หน่วย สิบ ร้อย พัน หมื่น แสน)
If Len(str1) Mod 6 <> 0 Then
nLoop = Int(Len(str1) / 6) + 1
Else
nLoop = Int(Len(str1) / 6)
End If

' แปลงตัวเลขชุดก่อนหน้าจุดทศนิยมให้เป็นตัวหนังสือ
sTemp2 = ""
For n = 1 To nLoop
m = Len(str1) - 6 * n
If n = 1 Then SpText = "บาท" Else SpText = "ล้าน" ' กำหนดค่าให้กับหลักหน่วยของเลขแต่ละชุด
If m >= 0 Then sTemp1 = Mid(str1, m + 1, 6) Else sTemp1 = Mid(str1, 1, m + 6)
sTemp2 = N2T(sTemp1, n) & SpText & sTemp2
bt1 = sTemp2
Next

' แปลงตัวเลขหลังจุดทศนิยมให้เป็นตัวหนังสือ
If Val(str2) = 0 Then bt2 = "ถ้วน" Else bt2 = N2T(str2, 1) & "สตางค์"


Selection.Text = bt1 & bt2 ' เปลี่ยนค่าตัวเลขที่เลือกไว้ให้เป็นตัวหนังสือ
End Sub

Function N2T(NStr As String, nLp As Integer) As String

Dim NumMain As Variant
Dim NumText As Variant
Dim LnStr As Integer, i As Integer, j As Integer
Dim StrTemp As String
Dim chTemp As String
Dim NumT As String
Dim NumM As String

NumMain = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
NumText = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
LnStr = Len(NStr) ' หาความยาวของชุดตัวเลข

j = 0 ' j เป็นค่าตำแหน่งของชุดตัวเลข
StrTemp = ""
For i = LnStr To 1 Step -1
j = j + 1
chTemp = Mid(NStr, i, 1) ' ค่าของตัวเลขที่ตำแหน่ง j

' กำหนดค่าพิเศษให้กับชุดตัวเลข
If Val(chTemp) = 1 And j = 1 And j <> LnStr Then
NumT = "เอ็ด"
ElseIf j = 2 And Val(chTemp) = 1 Then
NumT = ""
ElseIf j = 2 And Val(chTemp) = 2 Then
NumT = "ยี่"
Else
NumT = NumText(Val(chTemp))
End If

If Val(chTemp) = 0 Then NumM = "" Else NumM = NumMain(j - 1)
StrTemp = NumT & NumM & StrTemp ' รวมค่าตัวเลขแต่ละตำแหน่งที่แปลงเป็นตัวหนังสือแล้ว
Next

N2T = StrTemp

End Function

 ******************************

สามารถนำไปใส่ในแมโครของ MS Word เพื่อเรียกใช้ได้เลยนะครับ