MACRO TULIS TEKS TANGGAL EXCEL

Sumber : Tutorial Microsoft Excel Dot Net

Buatlah/Tambahkan sebuah module baru dengan memilih menu Insert > Module pada Visual Basic Editor.

Untuk menggunakan fungsi tersebut 
=charTanggal(A4)
=============================

Private Function KeKata(Nomor)
TrjKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
KeKata = TrjKata(Nomor)
End Function

Public Function CharTanggal(Tgl As Date) As String
Dim numMo, numYrs, numDay As Integer
Dim charMo, charYrs, charDay, charTgl
AngkaKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
'KTahun = AngkaKata(No)

numDay = Weekday(Tgl)
Select Case numDay
    Case 1:
        charDay = "Minggu"
    Case 2:
        charDay = "Senin"
    Case 3:
        charDay = "Selasa"
    Case 4:
        charDay = "Rabu"
    Case 5:
        charDay = "Kamis"
    Case 6:
        charDay = "Jumat"
    Case 7:
        charDay = "Sabtu"
End Select

numTanggal = Day(Tgl)
tgl1 = Left(Right(numTanggal, 1), 1)
tgl2 = Left(Right(numTanggal, 2), 1)

If Len(numTanggal) = 1 Then
    charTgl = KeKata(numTanggal)
End If
If Len(numTanggal) > 1 Then
   If tgl1 = 0 And tgl2 = 1 Then
      charTgl = "Sepuluh"
   ElseIf tgl1 = 1 And tgl2 = 1 Then
    charTgl = " Sebelas"
   ElseIf tgl1 > 1 And tgl2 = 1 Then
   charTgl = KeKata(tgl1) & " belas"
   Else
   charTgl = KeKata(tgl2) & " puluh " & KeKata(tgl1)
   End If
End If

numMo = Month(Tgl)
Select Case numMo
    Case 1:
        charMo = "Januari"
    Case 2:
        charMo = "Februari"
    Case 3:
        charMo = "Maret"
    Case 4:
        charMo = "April"
    Case 5:
        charMo = "Mei"
    Case 6:
        charMo = "Juni"
    Case 7:
        charMo = "Juli"
    Case 8:
        charMo = "Agustus"
    Case 9:
        charMo = "September"
    Case 10:
        charMo = "Oktober"
    Case 11:
        charMo = "Nopember"
    Case 12:
        charMo = "Desember"

End Select
numYrs = Year(Tgl)
No1 = Left(Right(numYrs, 1), 1)
No2 = Left(Right(numYrs, 2), 1)
No3 = Left(Right(numYrs, 3), 1)
No4 = Left(Right(numYrs, 4), 1)

'Satuan
If Len(numYrs) >= 1 Then
    If Len(numYrs) = 1 And No1 = 1 Then
    Nomor1 = "satu"
    ElseIf Len(numYrs) = 1 And No1 = 0 Then
    Nomor1 = "Nol"
    ElseIf No2 = "1" Then
        If No1 = "1" Then
        Nomor1 = "sebelas"
        ElseIf No1 = "0" Then
        Nomor1 = "sepuluh"
        Else
        Nomor1 = KeKata(No1) & " belas"
        End If
    
    Else
    Nomor1 = KeKata(No1)
    End If
Else
Nomor1 = ""
End If

'Puluhan
If Len(numYrs) >= 2 Then
    If No2 = 1 Or No2 = "0" Then
    Nomor2 = ""
    Else
    Nomor2 = KeKata(No2) & " puluh "
    End If
Else
Nomor2 = ""
End If
'Ratusan
If Len(numYrs) >= 3 Then
    If No3 = "1" Then
    Nomor3 = "seratus "
    ElseIf No3 = "0" Then
    Nomor3 = ""
    Else
    Nomor3 = KeKata(No3) & " ratus "
    End If
Else
Nomor3 = ""
End If

If Len(numYrs) >= 4 Then
    If No6 = "0" And No5 = "0" And No4 = "0" Then
    Nomor4 = ""
    ElseIf (No4 = "1" And Len(numYrs) = 4) Or (No6 = "0" And No5 = "0" And No4 = "1") Then
    Nomor4 = "seribu "
    ElseIf No5 = "1" Then
        If No4 = "1" Then
        Nomor4 = "sebelas ribu "
        ElseIf No4 = "0" Then
        Nomor4 = "sepuluh ribu "
        Else
        Nomor4 = KeKata(No4) & " belas ribu "
        End If

    Else
    Nomor4 = KeKata(No4) & " ribu "
    End If
Else
Nomor4 = ""
End If

charYrs = Trim(Nomor4 & Nomor3 & Nomor2 & Nomor1)

CharTanggal = charDay & " tanggal " & charTgl & " bulan " & charMo & " tahun " & charYrs

End Function

Search Post

Label :