Topic này sẽ hướng dẫn các bạn tạo một hàm đọc số ra chữ bằng tiếng Việt Unicode sử dụng trong Open Office phiên bản từ 3.x
Các thao tác để vào màn hình soạn thảo Open basics tương tự như hướng dẫn tại topic này
Trên cơ sở Code viết Hàm đọc số ra chữ Unicode viết trên VBA, sự khác biệt giữa Open Basic và Visual Basic nằm ở chỗ hàm ChrW$() của VBA và Chr$() của Open Basic. Ta chỉ cần thay ChrW$() thành Chr$() là xong.
Đây là đoạn code dành cho Open Basic
Các bạn xem file đính kèm nhé.
Trong trường hợp khi mở file đính kèm lên mà thấy xuất hiện lỗi như sau:
Lúc này đừng lo lắng. Click OK và sau đó Vào Tool/Option và thao tác như hình bên dưới nhé!
Sau đó đóng file này lại và sau đó mở lại, lúc này nhớ chọn Enable Macro nhé!
Chúc các bạn một ngày làm việc vui vẻ và thành công!
Các thao tác để vào màn hình soạn thảo Open basics tương tự như hướng dẫn tại topic này
Trên cơ sở Code viết Hàm đọc số ra chữ Unicode viết trên VBA, sự khác biệt giữa Open Basic và Visual Basic nằm ở chỗ hàm ChrW$() của VBA và Chr$() của Open Basic. Ta chỉ cần thay ChrW$() thành Chr$() là xong.
Đây là đoạn code dành cho Open Basic
PHP:
Function VND(baonhieu)
'Tien Viet tieng Viet Font Unicode
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim I, J, ViTri As Byte, S As Double
Dim Hang, Doc, Dem
If Trim(baonhieu) = "" Then
VND = ""
Exit Function
ElseIf baonhieu = 0 Then
VND = "kh" & Chr(244) & "ng"
Exit Function
ElseIf IsDate(baonhieu) Then
ngay = Day(baonhieu)
Thang = Month(baonhieu)
Nam = Year(baonhieu)
VND = "ng" & Chr(224) & "y " & ngay & " th" & Chr(225) & "ng " & Thang & " n" & Chr(462) & "m " & Nam
Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'If baonhieu = 0 Then
'KetQua = "Kh" & Chr$(244) & "ng " & Chr$(273) & Chr$(7891) & "ng"
'Else
'---------------------------------------------------------------------------------------------------------------------------------
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & Chr$(7889) & " qu" & Chr$(225) & " l" & Chr$(7899) & "n - H" & Chr$(224) & "m " & Chr$(273) & Chr$(7893) & "i s" & Chr$(7889) & " ra ch" & Chr$(7919) & " Vi" & Chr$(7879) & "t Nam; font ch" & Chr$(7919) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
Else
If baonhieu < 0 Then
KetQua = Chr$(194) & "m" & Space(1)
Else
KetQua = Space(0)
End If
SoTien = Format(Abs(baonhieu), "##############0.00")
SoTien = Right(Space(15) & SoTien, 18)
Hang = Array("None", "tr" & Chr$(259) & "m", "m" & Chr$(432) & Chr$(417) & "i", "g" & Chr$(236) & " " & Chr$(273) & "ã")
Doc = Array("None", "ng" & Chr$(224) & "n t" & Chr$(7927), "t" & Chr$(7927), "tri" & Chr$(7879) & "u", "ng" & Chr$(224) & "n", Chr$(273) & Chr$(7891) & "ng", "")
Dem = Array("None", "m" & Chr$(7897) & "t", "hai", "ba", "b" & Chr$(7889) & "n", "n" & Chr$(259) & "m", "s" & Chr$(225) & "u", "b" & Chr$(7849) & "y", "t" & Chr$(225) & "m", "ch" & Chr$(237) & "n")
For I = 1 To 6
Nhom = Mid(SoTien, I * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If I = 5 Then
Chu = Chr$(273) & Chr$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & Chr$(7861) & "n"
Case Else
S1 = Left(Nhom, 1)
S2 = Mid(Nhom, 2, 1)
S3 = Right(Nhom, 1)
Chu = Space(0)
Hang(3) = Doc(I)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(Nhom, J, 1))
If S > 0 Then
Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
End If
Select Case J
Case 2 And S = 1
Dich = "m" & Chr$(432) & Chr$(7901) & "i" & Space(1)
Case 3 And S = 0 And Nhom <> Space(2) & "0"
Dich = Hang(J) & Space(1)
Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
Dich = "l" & Mid(Dich, 2)
Case 2 And S = 0 And S3 <> "0"
If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
Dich = "l" & Chr$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & Chr$(432) & Chr$(417) & "i m" & Chr$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & Chr$(432) & Chr$(417) & "i m" & Chr$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
Trong trường hợp khi mở file đính kèm lên mà thấy xuất hiện lỗi như sau:
Lúc này đừng lo lắng. Click OK và sau đó Vào Tool/Option và thao tác như hình bên dưới nhé!
Sau đó đóng file này lại và sau đó mở lại, lúc này nhớ chọn Enable Macro nhé!
Chúc các bạn một ngày làm việc vui vẻ và thành công!
File đính kèm
Chỉnh sửa lần cuối bởi điều hành viên: