Senin, 13 Mei 2019

Menampilkan terbilang pada ms-word

Membuat sebuah invoice pembayaran membutuhkan terbilang pada total yang harus di bayarkan
ini dapat memiliki resiko ke salahan yang cukup fatal.
oleh sebab itu kita akan membuat sebuah rumus macros pada ms word kita.




Script :

Option Explicit

Sub ctvTerbilang()
   Dim Number As Variant, Kata As String, sText As String
   Const Ttel As String = "Terbilang Max 18 digit saja loh!"
   
   sText = Replace(Selection, Chr(10), "")
   Selection = sText
   If IsNumeric(Selection) Then
      Number = CDec(Selection)
      With Selection
         .Copy
         .EndKey Unit:=wdLine
         .TypeParagraph
      End With

      Select Case Number
         Case 0
            Kata = "Zero"
         Case 0.001 To 1E+18
            Kata = TERBILANG(Number)
         Case Else
            MsgBox "Bilangan Terlalu besar!", 48, Ttel
      End Select
   Else
      MsgBox "Tidak ada bilangan di dalam selection!!", 48, Ttel
   End If
   Selection = Kata
End Sub


Private Function TERBILANG(Nnum As Variant) As String
  '== siti Vi  <Villager.girl@Gmail.com>,=====
  '== STDEV(i) <setiyowati.devi@Gmail.com>,===
  '--- revisi awal jan 2012 ------------------
   Dim nUtuh As Variant, nDesi As Variant
   Dim sUtuh As String, sDesi As String
   Nnum = CDec(Round(Nnum, 2))
   nUtuh = CDec(Int(Nnum))
   nDesi = CDec(Round((Nnum - nUtuh) * 100, 0))
   sUtuh = TransX(nUtuh)
   If nDesi = 0 Then
      sDesi = ""
   Else
      sDesi = "dan " & TransX(nDesi) & " per seratus"
   End If
   TERBILANG = Trim(sUtuh & " " & sDesi)
End Function


Private Function TransX(Bilangan As Variant) As String
  '== siti Vi  <Villager.girl@Gmail.com>,=====
  '== STDEV(i) <setiyowati.devi@Gmail.com>,===
  '--------------------------------------------
   Dim TxtBil As String, Teks As String, i As Integer, Pos As Integer
   Dim Angka(19) As String, Puluh(9) As String, Letak(4) As String
   Dim DwiDigit As Byte, TriD1 As Byte, TriD2 As Byte, TriD3 As Byte
   Angka(1) = "satu":         Angka(2) = "dua":           Angka(3) = "tiga"
   Angka(4) = "empat":        Angka(5) = "lima":          Angka(6) = "enam"
   Angka(7) = "tujuh":        Angka(8) = "delapan":       Angka(9) = "sembilan":
   Angka(10) = "sepuluh":     Angka(11) = "sebelas":      Angka(12) = "dua belas"
   Angka(13) = "tiga belas":  Angka(14) = "empat belas":  Angka(15) = "lima belas"
   Angka(16) = "enam belas":  Angka(17) = "tujuh belas":  Angka(18) = "delapan belas"
   Angka(19) = "sembilan belas"
   Puluh(0) = "":             Puluh(2) = "dua puluh":     Puluh(3) = "tiga puluh"
   Puluh(4) = "empat puluh":  Puluh(5) = "lima puluh":    Puluh(6) = "enam puluh"
   Puluh(7) = "tujuh puluh":  Puluh(8) = "delapan puluh": Puluh(9) = "sembilan puluh"
   Letak(0) = "ribu":    Letak(1) = "juta"
   Letak(2) = "milyar":  Letak(3) = "triliun":   Letak(4) = "kuadriliun"
   Bilangan = CDec(Bilangan)
   TxtBil = Trim(Str(Round(Abs(Bilangan), 0)))
   If CDec(TxtBil) = 0 Then
      Teks = "nol "
   Else
      i = 0
      Do
         TxtBil = "000" + TxtBil
         DwiDigit = CByte(Right(TxtBil, 2))
         If (DwiDigit > 0) And (DwiDigit < 20) Then
            Teks = IIf((Bilangan < 2000 And i = 1), "se", Angka(DwiDigit) + " ") + Teks
         Else
            TriD3 = CByte(Right(TxtBil, 1))
            If (TriD3 > 0) Then Teks = Angka(TriD3) + " " + Teks
            TriD2 = CByte(Left(Right(TxtBil, 2), 1))
            If (TriD2 > 0) Then Teks = Puluh(TriD2) + " " + Teks
         End If
         TriD1 = CByte(Left(Right(TxtBil, 3), 1))
         If (TriD1 = 1) Then Teks = "seratus " + Teks
         If (TriD1 > 1) Then Teks = Angka(TriD1) + " ratus " + Teks
         TxtBil = Left(TxtBil, Len(TxtBil) - 3)
         If (CDec(TxtBil) > 0) Then
            Teks = IIf(CInt(Right(TxtBil, 3)) = 0, "", Letak(i) + " ") + Teks
            i = i + 1
         End If
      Loop While ((CDec(TxtBil) > 0) And (i < 6))
   End If
   TransX = Trim(Teks) &" rupiah"
End Function
'------------------------


Share:

0 komentar:

Posting Komentar

BTemplates.com