'Mã chuyển một số sang một chuỗi
Public Function NumToText(mVarStr As String) As String
Static Ones(0 To 11) As String, Teens(0 To 9) As String, Tens(0 To 9) As String
Static Thousands(0 To 4) As String, bInit As Boolean
Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
Dim StrVal As String, StrBuff As String, StrTemp As String
Dim nCol As Integer, nChar As Integer
Dim J&
J = Len(CStr(CLng(mVarStr)))
'Chỉ làm việc cho các số dương
Debug.Assert mVarStr >= 0
If bInit = False Then
'Bắt đầu tạo mảng
bInit = True
Ones(0) = "Không"
Ones(1) = "Một"
Ones(2) = "Hai"
Ones(3) = "Ba"
Ones(4) = "Bốn"
Ones(5) = "Năm"
Ones(6) = "Sáu"
Ones(7) = "Bảy"
Ones(8) = "Tám"
Ones(9) = "Chín"
Ones(10) = "Mốt"
Ones(11) = "Tư"
Teens(0) = "Mười"
Teens(1) = "Mười Một"
Teens(2) = "Mười Hai"
Teens(3) = "Mười Ba"
Teens(4) = "Mười Bốn"
Teens(5) = "Mười Năm"
Teens(6) = "Mơừi Sáu"
Teens(7) = "Mười Bảy"
Teens(8) = "Mơừi Tám"
Teens(9) = "Mười Chín"
Tens(0) = ""
Tens(1) = "Mười"
Tens(2) = "Hai Mươi"
Tens(3) = "Ba Mươi"
Tens(4) = "Bốn Mươi"
Tens(5) = "Năm Mươi"
Tens(6) = "Sáu Mươi"
Tens(7) = "Bảy Mươi"
Tens(8) = "Tám Mươi"
Tens(9) = "Chín Mươi"
Thousands(0) = ""
Thousands(1) = "Nghìn"'
Thousands(2) = "Triệu"
Thousands(3) = "Tỉ"
Thousands(4) = "Nghìn"
End If
'Bẫy lỗi
On Error GoTo Err2TextTrap
'Lấy phần lẻ
'StrBuff = "Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100"
'Chuyển định dạng dữ liệu vào
StrVal = CStr(CLng(mVarStr))
'Tất cả cả số đều là Zero
bAllZeros = True
'Làm vòng lặp với chuỗi sau khi chuyển định dạng
For i = Len(StrVal) To 1 Step -1
'Lấy từng kí số
nChar = Val(Mid$(StrVal, i, 1))
'Tìm số cột cho kí số
nCol = (Len(StrVal) - i) + 1
'Chọn ở hàng đơn vị 1,10,100
Select Case (nCol Mod 3)
Case 1'Trường hợp là 1
bShowThousands = True
If i = 1 Then
'Số đầu tiên
StrTemp = Ones(nChar) & " "
ElseIf Mid$(StrVal, i - 1, 1) = "1" Then
'Các số sau ở trong hàng mười
StrTemp = Teens(nChar) & " "
i = i - 1'Giữ lại các số có hai con số
ElseIf nChar > 0 Then
'Các số có một con số
StrTemp = Ones(nChar) & " "
Else
bShowThousands = False
If Mid$(StrVal, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(StrVal, i - 2, 1) <> "0" Then bShowThousands = True
End If
StrTemp = ""
End If
If bShowThousands Then
If nCol > 1 Then
StrTemp = StrTemp & Thousands(nCol \ 3)
If bAllZeros Then
StrTemp = StrTemp & " "
Else
StrTemp = StrTemp & ", "
End If
End If
bAllZeros = False
End If
StrBuff = StrTemp & StrBuff
Case 2
If nChar > 0 Then
If Mid$(StrVal, i + 1, 1) <> "0" Then
StrBuff = Tens(nChar) & " " & StrBuff
Else
StrBuff = Tens(nChar) & " " & StrBuff
End If
End If
Case 0
If nChar > 0 Then StrBuff = Ones(nChar) & " Trăm " & StrBuff
End Select
Next i
StrBuff = Trim$(StrBuff)
If ((Right$(StrBuff, 3) = Ones(1))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(10)
If ((Right$(StrBuff, 3) = Ones(4))) And (J > 2) Then _
StrBuff = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
' If ((Right$(StrBuff, 3) = Ones(4))) Then _
'StrTemp = Left$(StrBuff, Len(StrBuff) - 3) & Ones(11)
StrBuff = UCase$(Left$(StrBuff, 1)) & Mid$(StrBuff, 2)
'StrBuff = " Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100"
If (CDbl(mVarStr) - CLng(mVarStr) > 0) Then StrBuff = StrBuff _
& " ( Và " & Format((mVarStr - CLng(mVarStr)) * 100, "00") & "/100)"
Err2Text:
NumToText = StrBuff
Exit Function
Err2TextTrap:
StrBuff = "#Error#"
Resume Err2Text
End Function
![[Mì Tôm Chanh]](/data/avatars/m/1100/1100545.jpg?1473321991){kind=avatar}
