Module Terbilang Automatis Di Excel

Unknown Reply 10:01 AM
Tinggal masuk ke menu developer kemudian pilih visual basic.

Copy dan Paste Code sebagai berikut :
Dim Huruf(0 To 9) As String
Dim AX(0 To 3) As Double

Public Sub InitAngka()
    Huruf(0) = ""
    Huruf(1) = "satu "
    Huruf(2) = "dua "
    Huruf(3) = "tiga "
    Huruf(4) = "empat "
    Huruf(5) = "lima "
    Huruf(6) = "enam "
    Huruf(7) = "tujuh "
    Huruf(8) = "delapan "
    Huruf(9) = "sembilan "
End Sub

Public Function DgRatus(ByVal A As Double) As String
Dim Angka As Long

Angka = Int(A)
temp = ""
InitAngka

panjang = Len(Trim(Str(Angka)))
nilai = Right("000", 3 - panjang) & Trim(Str(Angka))

For y = 3 To 1 Step -1
    AX(y) = Mid(nilai, y, 1)
    Next y

Select Case AX(1)
    Case Is = 1
        temp = "seratus "
    Case Is > 1
        temp = Huruf(Val(AX(1))) & "" & "ratus "
    Case Else
        temp = ""
End Select

Select Case AX(2)
    Case Is = 0
        temp = temp & Huruf(Val(AX(3)))
    Case Is = 1
        Select Case AX(3)
            Case Is = 1
            temp = temp & "sebelas "
            Case Is = 0
            temp = temp & "sepuluh "
    Case Else
        temp = temp & Huruf(Val(AX(3))) & "belas "
End Select
Case Is > 1
    temp = temp & Huruf(Val(AX(2))) & "puluh "
    temp = temp & "" & Huruf(Val(AX(3)))
End Select
DgRatus = temp
End Function

Function DgHuruf(A As Double) As String
    Dim Ratusan(0 To 6) As String
    Dim Sebut(0 To 4) As String
    Dim Koma As String
    Dim Angka As Double
    Dim AAA As String
   
    On Error GoTo salah
    Koma = Format(A, "##############0.#0")
Angka = A - (Val(Right(Koma, 2)) / 100)
Sebut(1) = "ribu "
Sebut(2) = "juta "
Sebut(3) = "milyar "
Sebut(4) = "triliun "

panjang = Len(Trim(Str(Angka)))
Kl = Int(panjang / 3)
If Int(panjang / 3) * 3 <> panjang Then
    Kl = Kl + 1
    sisa = panjang - Int(panjang / 3) * 3
    nilai = Right("000", 3 - sisa) & Trim(Str(Angka))
Else
    nilai = Trim(Str(Angka))
End If

For x = 0 To Kl
    Ratusan(Kl - x) = Mid(nilai, x * 3 + 1, 3)
Next x

For y = Kl To 1 Step -1
    If y = 2 And Val(Ratusan(y)) = 1 Then
        temp = temp & "seribu "
    Else
        If Val(Ratusan(y)) = 0 Then
            temp = temp
        Else
            temp = temp & DgRatus(Val(Ratusan(y)))
            temp = temp & Sebut(y - 1)
        End If
    End If
Next y

DgHuruf = UCase(Left(temp, 1)) & Mid(temp, 2, Len(temp) - 1)

Koma = Format(A, "##############0.#0")

If Right(Koma, 2) = "00" Then
    DgHuruf = DgHuruf
Else
    If Val(Right(Koma, 2)) < 10 Then
        DgHuruf = DgHuruf & " " & Right(Koma, 1) & "/100 "
    Else
        DgHuruf = DgHuruf & " " & Right(Koma, 2) & "/100 "
    End If
End If
DgHuruf = DgHuruf & "rupiah,-"
Exit Function
salah:
MsgBox "Kata Ferdinan S, Terjadi Kesalahan" & vbCr & vbCr & _
        Err.Description & vbCr & Err.Number & vbCr & Err.Source, vbCritical, "KESALAHAN"
End Function



Note : Cara panggil pada kolom formula ketik "DgHuruf(NAMAKOLOM)".

Excel 2003 Tidak Bisa Move Sheet Microsoft Office

Unknown Reply 10:18 AM
Try this. It worked for me. Check that the workbooks are of same type. i.e. both are .xlxs workbooks. If not convert to same format. Close excel. Restart excel. Open both workbooks from inside the file dialogue box under Recent Documents. That is workbooks should be opened from same instance of excel opening. Select the worksheet to be copied. Right click. Click on move or copy tab. Click on Create a copy. Select the workbook to which worksheet is to be opened from To Book and choose location from "before sheet". That's it.


Artinya : :)

Kita harus buka salah satu excel kemudian buka excel tujuan yang akan kita pindahkan pada tab recent document pada file. Untuk mengenalkan excel satu sama lain.

Search

Ikuti Channel Youtube Aku Yaa.. Jangan Lupa di subscribe. Terima kasih.

Popular Posts

Translate