Tag: VBA

[DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word

Referensi : https://support.microsoft.com/en-us/kb/213360
Lokasi File :  
Platform : Microsoft Word

Tulisan kali ini tidak ada hubungannya dengan peta, geodesy, project management, autocad ataupun civil 3D tetapi berhubungan dengan tugas baru saya sebagai  tukang ketik dan tukang catat dokumen kontrak.

Sebagai tukang ketik dan tukang catat, salah satu pekerjaan yang sering berulang adalah menuliskan angka terbilang nilai kontrak dari angka ke tulisan ( konversi angka ke huruf) menggunakan Bahasa Ingris dengan software Microsoft Word.

Sebelumnya saya menggunakan formula di [XLS-PMG-04]: Spell Number in Excel Without Macro (No VBA) untuk proses konversi ini dalam Microsoft Excel. Tetapi karena dokumen kontrak ditulis dalam Microsoft Word, saya menggunakan fasilitas Visual Basic Application for Microsoft Word (VBA for MS Word) untuk melakukan proses otomasi ini.

VBA for MS Word yang saya tulis di bawah ini adalah modifikasi code vba dari https://support.microsoft.com/en-us/kb/213360 dengan beberapa perubahan kecil antara lain:

1. Merubah vba code yang semula berupa user defined function di excel, menjadi vba code untuk digunakan di Microsoft Word.

2. Menghilangkan kata dollar dan cent. Kontrak yang saya ketik dalam mata uang rupiah dimana tidak ada satuan cents.

3. Hanya bekerja di angka bulat tanpa ada desimal.

4. Menambahkan karakter dash (“-“) di angka 20-99.

Detail vba-code ada di bawah ini:

Sub Spell2Number()
‘source: https://support.microsoft.com/en-us/kb/213360
‘modified by: zainul_ulum@cbn.net.id (znl)
‘date: 15 Mei 2016
‘modification notes:
‘1. to be applied on microsoft word
‘2. delete words: dollar dan cent
‘3. works only for integer number and no decimals
‘4. add dash character If number value between 20-99…
‘tanggal 15 Mei 2016
‘required procedures and functions:
‘1. SpellNumber
‘2. GetHundreds
‘3. GetTens
‘4. GetDigit

    Selection.Text = SpellNumber(Selection.Text)
End Sub
Private Function SpellNumber(ByVal MyNumber)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    ‘ String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    ‘ Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ‘ Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace – 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) – 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
    Select Case Dollars
        Case ""
            ‘Dollars = "No Dollars"
            Dollars = "" ‘>>znl
        Case "One"
            ‘Dollars = "One Dollar"
            Dollars = "One" ‘>>znl
         Case Else
            ‘Dollars = Dollars & " Dollars"
            Dollars = Dollars & " " ‘>>znl
    End Select
    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
              Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    Cents = "" ‘>>znl
    SpellNumber = Dollars & Cents
End Function
     
‘ Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    ‘ Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
    End If
    ‘ Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    GetHundreds = Result
End Function
     
‘ Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim Result As String
    Result = ""           ‘ Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ‘ If value between 10-19…
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
        End Select
    Else                                 ‘ If value between 20-99…
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty-"
            Case 3: Result = "Thirty-"
            Case 4: Result = "Forty-"
            Case 5: Result = "Fifty-"
            Case 6: Result = "Sixty-"
            Case 7: Result = "Seventy-"
            Case 8: Result = "Eighty-"
            Case 9: Result = "Ninety-"
            Case Else
        End Select
        Result = Result & GetDigit _
            (Right(TensText, 1))  ‘ Retrieve ones place.
       
        ‘znl remove dash character if GetDigit=""
        If GetDigit(Right(TensText, 1)) = "" Then
            Result = Left(Result, Len(Result) – 1)
        End If
       
    End If
    GetTens = Result
End Function
    
‘ Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
    End Select
End Function

Cara menggunakan code di atas:

  1. Copy code di atas atau download dari Link ini.
  2. Jalankan program Microsoft Word (MS Word).
  3. Pada Blank Document di MS Word, aktifkan Microsoft Visual Basic for Applications dengan menekan tombol Alt+F11.
  4. “Click Kanan” [ThisDocument] di bawah [Microsot Word Objects] dalam folder [Normal], kemudian pilih [Insert]>>[Module]

image

5. “Paste” code di [Module] yang telah dibuat, kemudian “Click” tombol [Save]. Program telah tersimpan dalam normal template sehingga setiap kali word dijalankan, program konversi huruf siap digunakan.

6. Tutup [Microsoft Visual Basic for Applications], sehingga kembali ke Blank Document.

7.  Pada Blank Document, tuliskan angka yang akan dikonversi. Misal 126752346

8. Tulisan angka sebaiknya berupa angka bulan tanpa ada simbol pemisah ribuan.

9. “Select” atau “Block” angak tadi (126752346)

10. Jalankan VBA (Macro) dengan menekan tombol Alt+F8

image

11. “Pilih” Macro [Spell2Number], kemudian “click” tombol [Run]

12. Angka sudah dikonversi dalam huruf dalam Bahasa Inggris.

Tahapan di bawah adalah contoh penggunaannya dalam pekerjaan saya:

1. File Normal Template sudah terdapat macro (vba) konversi.

2. Membuka file draft kontak dengan Microsoft Word kemudian menge-block angka yang akan dikonversi.

image

3. Menekan tombol Alt+F8 kemudian menjalankan macro [Spell2Number]

4. Hasil konversi angkan ke huruf:

image

 

Silakan mencoba.

“Jadilah tukang ketik yang kerja cerdas, bukan kerja keras”

[XLS-MAP-03]: Plotting List Koordinat dari Excel ke AutoCAD

 

Referensi : import point dengan autolisp
Platform : Excel dan AutoCAD
Lokasi File : download

Pada awalnya saya ingin membuat program visual basic application yang ada di Autocad 2011 untuk menggambarkan lokasi titik-titik sesuai dengan list koordinat yang ada di excel. Tetapi saat saya menekan tombol Alt+F11 untuk mengaktifkan visual basic di AutoCAD 2011 muncul pesan “Microsoft Visual Basic for Application Software is no longer installed with AutoCAD”. Sebetulnya masih disupport oleh Autodesk, tetapi harus download dulu di sini.

Daripada download (sebetulnya pingin sih), saya coba cara lain dengan memanfaatkan program Microsoft Visual Basic for Application yang ada di Excel (Macro). Koneksi AutoCAD dan Excel bisa dilakukan dengan cara memilih ‘AutoCAD 2011 Type Library’ di pilihan References-VBA Project. Jika Anda menggunakan versi AutoCAD yang lain, pilihlah library dengan nama ‘AutoCAD xxxx Type Library’, dimana xxxx adalah versi AutoCAD yang sedang Anda gunakan. misal untuk AutoCAD 2010, maka librarynya adalah ‘AutoCAD 2010 Type Library’.

Contoh List Koordinat di Excel yang akan diplot di AutoCAD adalah :

image

Bujur akan diplot sebagai koordinat X, Lintang adalah koordinat Y dan  Elevasi adalah Z. Text Keterangan akan diplot sesuai dengan posisi titik tersebut (XYZ).

 

 

 

 

 

 

1. Buka file Excel yang berisi list koordinat Saat file excel sudah terbuka, pilih sheet yang berisi list koordinatnya, kemudian tekan Alt+F11 untuk mengaktifkan visual basic editor.
Dari Menu ‘Insert’ pilih ‘Module’
2. Jalankan program AutoCAD, tanpa menutup program Excel Jika diinginkan, pilih layer dan text style di AutoCAD.
3. Setting Reference ke AutoCAD Library pada visual basic editor, pilih menu ‘Tools’ kemudian ‘References’.
Pilih AutoCAD Library sesuai dengan versi AutoCAD yang aktif di pilihan available references. 

image
click OK jika library sudah dipilih.

4. Tulis Macro atau Visual basic di module Option Explicit
Sub PlotKeAutocad()
Dim rgKoordinat As Range

‘table list koordinat di sheet yang aktif
Set rgKoordinat = ActiveSheet.UsedRange
rgKoordinat.Select

Dim respon As Long
If MsgBox(“Pilihan Sudah Benar?”, vbYesNo) = vbNo Then Exit Sub

Dim c As Range, i As Integer, j As Integer
Dim lstKoord() As Double, lstDes() As String

‘membaca list koordinat dan nama titik dari excel
i = -1: j = -1
For Each c In rgKoordinat.Columns(1).Cells
If Application.IsNumber(c) Then
i = i + 3
j = j + 1
ReDim Preserve lstKoord(i)
lstKoord(i – 2) = c
lstKoord(i – 1) = c.Offset(, 1)
lstKoord(i) = c.Offset(, 2)

ReDim Preserve lstDes(j)
lstDes(j) = c.Offset(, 3)
End If
Next

‘koneksi ke autocad, program autocad harus sudah dijalankan
Dim appCAD As AcadApplication
On Error Resume Next
Set appCAD = GetObject(, “AutoCAD.Application”)
If Err.Number Then Exit Sub

Dim Koordinat(0 To 2) As Double
Const TinggiHuruf = 0.002 ‘rubah angka sesuai dengan tinggi huruf yang diinginkan
j = -1
For i = LBound(lstKoord) To UBound(lstKoord) Step 3
j = j + 1
Koordinat(0) = lstKoord(i)
Koordinat(1) = lstKoord(i + 1)
Koordinat(2) = lstKoord(i + 2)
With appCAD.ActiveDocument.ModelSpace
.AddPoint Koordinat ‘plot koordinat
.AddText lstDes(j), Koordinat, TinggiHuruf
End With
Next i

appCAD.ZoomExtents
AppActivate appCAD.Caption
Set appCAD = Nothing
End Sub

5. Menjalankan Program atau Macro Kembali ke sheet list koordinat.
Tekan Alt+F8, kemudian pilih macro PlotKeAutocad , kemudian click Run
6. Check di AutoCAD, apakah titik2 tersebut sudah benar possisinya?