coretan tentang autocad dan excel

October 15, 2017

[DOC-VBA-02]: Aplikasi Fungsi Terbilang di Microsoft Word Rev.1

Filed under: Microsoft Word — Tags: , — cadex @ 20:01
Referensi :
[DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word
Platform : Microsot Word
Lokasi File : Download

Pada tulisan   [DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word code diambil dari https://support.microsoft.com/en-us/kb/213360 dengan sedikit modifikasi.

Sedangkan pada tulisan ini adalah versi Visual Basic Application (VBA) dari [XLS-PMG-08]: Fungsi Terbilang Di Excel Tanpa Macro Versi Mega Formula Rev.03 berupa macro sehingga bisa digunakan di Microsoft Word.

Ada dua Procedure / Macro dan dua Fungsi dalam VBA tersebut :

Procedure / Macro Fungsi yang dijalankan Keterangan
Terbilang fTerbilang untuk mengubah angka ke bahasa indonesia
Spell2Number fSpellNumber untuk mengubah angka ke bahasa inggris

1. Procedure / Macro Terbilang

Sub Terbilang()
    Selection.Text = fTerbilang(Selection.Text)
End Sub

Function fTerbilang(dAngka As Variant)

‘Keterangan : Fungsi ini akan merubah angka menjadi huruf atau terbilang
‘maksimal angka adalah 999999999999.99
‘jika melebihi angka tersebut tidak akan diproses.
‘dibuat oleh: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017
    Const dMAX_NUMBER As Double = 999999999999.99
    Const sFormat As String = "000000000000.00"
    Dim arrHuruf As Variant
   
    arrHuruf = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", _
        "delapan", "sembilan", "sepuluh", "sebelas", "dua belas", "tiga belas", _
        "empat belas", "lima belas", "enam belas", "tujuh belas", "delapan belas", _
        "sembilan belas", "dua puluh", "tiga puluh", "empat puluh", "lima puluh", _
        "enam puluh", "tujuh puluh", "delapan puluh", "sembilan puluh")
   
    ‘Dim dAngka As Double
    ‘dAngka = 134912931#
   
    If dAngka > dMAX_NUMBER Then
        fTerbilang = "N/A"
        Exit Function
    End If

   
    Dim sAngka As String
   
    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)
   
    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String
   
    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))
   
    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " ratus")
   
    ‘mengganti "satu ratus" menjadi "seratus"
    sRatusan = Replace(sRatusan, "satu ratus", "seratus")
   
    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & " " & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan
   
    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " milyar", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " juta", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " ribu", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k
   
    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))
   
    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & " " & arrHuruf(CInt(Right(iSen, 1)))
    End If
   
    fTerbilang = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " dan " & sSen & " sen"))

End Function

2. Procedure / Macro Spell2Number

Sub Spell2Number()
    Selection.Text = fSpellNumber(Selection.Text)
End Sub

Function fSpellNumber(dAngka As Variant)
   
‘Descrition : This function converts number into text or spells number into text
‘maximum number can be converted is 999999999999.99
‘Function return "N/A" if the number exceeds of the allowable maximum number
‘coded by: zainul_ulum@cbn.net.id
‘Rev.0: 15 Oktober 2017
   
   
    Const sFormat As String = "000000000000.00"
    Const dMAX_NUMBER As Double = 999999999999.99
    Dim arrHuruf As Variant
   
    arrHuruf = Array("", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", _
    "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", _
    "eighteen", "nineteen", "twenty-", "thirty-", "forty-", "fifty-", "sixty-", "seventy-", "eighty-", "ninety-")
   
    ‘Dim dAngka As Double
    ‘dAngka = 134912931#
    If dAngka > dMAX_NUMBER Then
        fSpellNumber = "N/A"
        Exit Function
    End If
   
    Dim sAngka As String
   
    ‘merubah angka menjadi string
    sAngka = Format(dAngka, sFormat)
   
    Dim iRatusan As Integer, iPuluhan As Integer
    Dim idxHuruf As Integer, j As Integer, k As Integer
    Dim sTerbilang As String, sTerbilangPenuh As String
    Dim sRatusan As String, sPuluhan As String
   
    j = 1
    sTerbilangPenuh = ""
    For k = 0 To 3
    ‘angka ratusan
    iRatusan = CInt(Mid(sAngka, j, 1))
   
    ‘membaca angka Ratusan
    sRatusan = IIf(iRatusan = 0, "", arrHuruf(iRatusan) & " hundred")
   
    ‘mengganti "satu ratus" menjadi "seratus"
    ‘sRatusan = Replace(sRatusan, "satu ratus", "seratus")
   
    ‘angka Puluhan
    iPuluhan = CInt(Mid(sAngka, j + 1, 2))
    If iPuluhan <= 19 Then
        sPuluhan = arrHuruf(iPuluhan)
    Else
        sPuluhan = arrHuruf(18 + CInt(Left(iPuluhan, 1)))
        sPuluhan = sPuluhan & arrHuruf(CInt(Right(iPuluhan, 1)))
    End If
    sTerbilang = sRatusan & " " & sPuluhan
   
    ‘menambahkan kata milyar
    Select Case k
        Case 0
            sTerbilang = sTerbilang & IIf(dAngka / 1000000000# > 1, " billion", "")
        Case 1
            sTerbilang = sTerbilang & IIf(dAngka / 1000000# > 1, " million", "")
        Case 2
            sTerbilang = sTerbilang & IIf(dAngka / 1000# > 1, " thousand", "")
            ‘mengganti "satu ribu" menjadi "seribu"
            ‘sTerbilang = Replace(sTerbilang, "satu ribu", "seribu")
        Case Else
            sTerbilang = sTerbilang
    End Select
    sTerbilangPenuh = sTerbilangPenuh & " " & sTerbilang
    j = j + 3
    Next k
   
    ‘membaca sen
    Dim iSen As Integer, sSen As String
    iSen = CInt(Right(sAngka, 2))
   
    If iSen <= 19 Then
            sSen = arrHuruf(iSen)
        Else
            sSen = arrHuruf(18 + CInt(Left(iSen, 1)))
            sSen = sSen & arrHuruf(CInt(Right(iSen, 1)))
    End If
   
    fSpellNumber = Trim(sTerbilangPenuh & IIf(iSen = 0, "", " and " & sSen & " cent" & IIf(iSen > 1, "s", "")))

End Function

Cara penggunaan silakan baca di tulisan sebelumnya [DOC-VBA-01]: Aplikasi Fungsi Terbilang Di Microsoft Word.

==semoga bermanfaat==

Advertisements

[XLS-PMG-08]: Fungsi Terbilang di Excel Tanpa Macro Versi Mega Formula Rev.03

Filed under: Excel — Tags: , — cadex @ 13:45
Referensi :
[XLS-PMG-06]:Fungsi Terbilang Di Excel Tanpa Macro (Versi Mega Formula) Rev.02
Platform : Excel 2007
Lokasi File : Download

Tulisan ini adalah revisi ketiga dari posting sebelumnya dengan melakukan beberapa perubahan antara lain:

 

Rev.02

Rev.03

Panjang rumus konversi angka ke huruf:    
— Versi bahasa indonesia

1741

1362

— Versi bahasa inggris tanpa cents

2187

— Versi bahasa indonesia dengan sen  

1620

— Versi bahsa inggris dengan cents  

1376

Secara garis besar urutan untuk merubah angka menjadi huruf adalah:

A. VERSI KONVERSI TANPA ANGKA DESIMAL

Secara umum urutan yang saya pakai untuk merubah angka menjadi huruf adalah:

1. Proses pembacaan angka ke huruf dengan menggunakan bantuan 3 (tiga) “Named Range” yaitu:

— Named Range untuk memformat angka: _frm=REPT("0",12)

— Named Range larik/array angka: _angka={0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,30,40,50,60,70,80,90}

–Named Range larik/array huruf: _huruf={"","satu","dua","tiga","empat","lima","enam","tujuh","delapan","sembilan","sepuluh","sebelas","dua belas","tiga belas","empat belas","lima belas","enam belas","tujuh belas","delapan belas","sembilan belas","dua puluh","tiga puluh","empat puluh","lima puluh","enam puluh","tujuh puluh","delapan puluh","sembilan puluh"}

 

2. Format angka menjadi format text dengan panjang 12 karakter.

Misal angka di cell [A1] berisi angka 111456789876 (12 karakter), maka dengan menggunakan fungsi  =TEXT(A1,_frm) menjadi 111456789876 (12 karakter)

 

3. Angka digrupkan atau dibagi menjadi 4 (empat) yaitu : [Grup Milyar]= 111, [Grup Juta]= 457, [Grup Ribu]= 898 dan [Grup Satuan]= 876

 

4. Proses konversi dimulai berurutan dari [Grup Milyar], [Grup Juta],[Grup Ribu] dan [Grup Satuan]. Masing-masing grup terdiri dari [Ratusan] dan [Puluhan].

4.1 Konver Angka Milyar-an atau [Grup Milyar]

[Grup Milyar]=111 terdiri dari [Ratusan]= 1 dan [Puluhan]= 11

A. Konversi Angka Ratusan ke Huruf

Angka [Ratusan] diambil dengan rumus =MID(TEXT(A2,_frm),1,1) 

Dengan menggunakan fungsi  =INDEX(_huruf,[Ratusan]+1) atau =INDEX(_huruf,1+1) akan mengambil isi array _huruf yang ke 2 yaitu kata “satu” kemudian ditambahkan kata “ratus” sehingga rumusnya menjadi =INDEX(_huruf,1+1) & “ ratus”

Karena bahasa indonesia tidak mengenal kalimat “satu ratus”, maka rumus =INDEX(_huruf,1+1) & “ ratus” hanya berlaku jika [Ratusan]>1 sehinga jika  [Ratusan]= 1 tidak dilakukan pengambilan isi array _huruf tetapi langsung dirubah menjadi kata “seratus”.

Fungsi –MID(TEXT(A1,_frm),1,1)=1 untuk mengecek [Ratusan]=1, sedangkan –MID(TEXT(A1,_frm),1,1)>1 untuk mengecek [Ratusan]>1. Tanda double minus “–“ di depan MID berfungsi untuk merubah text “1” dari fungsi MID(TEXT(A1,_frm),1,1) menjadi angka 1.

Sedangkan untuk menampilkan menampilkan angka [Ratusan]=1 menggunakan fungsi

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)

dan fungsi

=REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)

untuk menampilkan [Ratusan]>1

Apabila digabungkan Fungsi [Ratusan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)

B. Konversi Angka Puluhan ke Huruf

Angka [Puluhan] diambil dengan fungsi =MID(TEXT(A1,_frm),2,2).

Hasil rumus ini kemudian dicek lagi jika [Puluhan]<=19, maka proses konversi langsung mengambil index dari array/larik _huruf dengan fungsi:

=INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)

sedangkan jika [Puluhan]>19, maka proses konversi dua tahap yaitu mengambil angka bulan puluhan di tambah dengan angka satuannya.

Fungsi untuk mengambil angka bulat untuk [Puluhan]>19

=LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf)

dan untuk mengambil angka satuannya:

=INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1))

Gabungan fungsi [Puluhan] menjadi:

=IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))

 

Sedangkan fungsi gabungan [Ratusan] dan [Puluhan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))

Fungsi di atas akan ditambahkan kata “milyar” jika nilai angka yang akan dikonversi lebih lebih dari satu milyar. Rumus untuk mengecek angka mencapai milyaran adalah:

=REPT(" milyar",(TEXT(A1,_frm)/10^9)>1)

Sehingga untuk grup [Milyar] dengan akhiran “ milyar” fungsinya menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))&REPT(" milyar",(TEXT(A1,_frm)/10^9)>1)

4.2 Konversi Angka Juta-an atau [Grup Juta]

Angka juta-an atau [Grup Juta] didapat dengan  memodifikasi fungsi / rumus MID() dari fungsi di atas.

=MID(TEXT(A1,_frm),1,1), artinya mengambil huruf dari text A1 yang telah diformat mulai dari huruf ke-1 sebanyak 1 huruf. Jika pengambilan karakter dimulai dari huruf ke 4 atau huruf ke-(1+3) akan didapat huruf ratusan dari [Grup Jutaan].

kemudian dengan memodifikasi REPT(" milyar",(TEXT(A1,_frm)/10^9)>1) menjadi REPT(" juta",(TEXT(A1,_frm)/10^3)>1) maka akan merubah akhiran “ milyar” menjadi “ juta”

Fungsi [Grup Juta] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),4,1)) &" ratus",–MID(TEXT(A1,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),5,2)),LOOKUP(–MID(TEXT(A1,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),6,1)))&REPT(" juta",(TEXT(A1,_frm)/10^6)>1)

4.3 Konversi Angka Ribua-an atau [Grup Ribu]

Dengan memodifikasi fungsi [Grup Juta], fungsi [Grup Ribu] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1)

Karena dalam bahasa indonesia tidak ada kalimat “satu ribu” maka diperlukan ditambahkan fungsi SUBSTITUTE () untuk merubah “satu ribu” menjadi “seribu”

=SUBSTITUTE(REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1),"satu ribu","seribu")

4.4. Konversi Angka Satuan [Grup Satuan]

Hasil modifikasi [Grup Ribu], funsi [Grup Satuan] menjadi:

=REPT("seratus ",–MID(TEXT(A1,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),10,1)) &" ratus",–MID(TEXT(A1,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),11,2)),LOOKUP(–MID(TEXT(A1,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),12,1)))

Rumus lengkap konversi angka ke huruf tanpa angka desimal:

=TRIM(REPT("seratus ",–MID(TEXT(A7,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),1,1)) &" ratus",–MID(TEXT(A7,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),2,2)),LOOKUP(–MID(TEXT(A7,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),3,1)))&REPT(" milyar",(TEXT(A7,_frm)/10^9)>1)&" "

&REPT("seratus ",–MID(TEXT(A7,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),4,1)) &" ratus",–MID(TEXT(A7,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),5,2)),LOOKUP(–MID(TEXT(A7,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),6,1)))&REPT(" juta",(TEXT(A7,_frm)/10^6)>1)&" "

&SUBSTITUTE(
REPT("seratus ",–MID(TEXT(A7,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),7,1)) &" ratus",–MID(TEXT(A7,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),8,2)),LOOKUP(–MID(TEXT(A7,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),9,1)))&REPT(" ribu",(TEXT(A7,_frm)/10^3)>1),"satu ribu","seribu")&" "

&REPT("seratus ",–MID(TEXT(A7,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A7,_frm),10,1)) &" ratus",–MID(TEXT(A7,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A7,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A7,_frm),11,2)),LOOKUP(–MID(TEXT(A7,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A7,_frm),12,1))))

 

B. VERSI KONVERSI DENGAN ANGKA DUA ANGKA DESIMAL (ANGKA DENGAN SEN)

Dengan merubah named range semula _frm=REPT("0",12) menjadi _frm=REPT("0",12)&MID(1/10,2,1)&"00" dan menambahkan fungsi di akhir rumus VERSI KONVERSI TANPA ANGKA DESIMAL:

&REPT(IF(–MID(TEXT(A1,_frm),14,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),14,2)),LOOKUP(–MID(TEXT(A1,_frm),14,2),_angka,_huruf)&" "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),15,1))) &" sen",–MID(TEXT(A1,_frm),14,2)>0)

Rumus lengkap konversi angka ke huruf dengan dua angka desimal (sen):

=TRIM(REPT("seratus ",–MID(TEXT(A1,_frm),1,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),1,1)) &" ratus",–MID(TEXT(A1,_frm),1,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),2,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),2,2)),LOOKUP(–MID(TEXT(A1,_frm),2,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),3,1)))&REPT(" milyar",(TEXT(A1,_frm)/10^9)>1)&" "

&REPT("seratus ",–MID(TEXT(A1,_frm),4,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),4,1)) &" ratus",–MID(TEXT(A1,_frm),4,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),5,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),5,2)),LOOKUP(–MID(TEXT(A1,_frm),5,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),6,1)))&REPT(" juta",(TEXT(A1,_frm)/10^6)>1)&" "

&SUBSTITUTE(
REPT("seratus ",–MID(TEXT(A1,_frm),7,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),7,1)) &" ratus",–MID(TEXT(A1,_frm),7,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),8,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),8,2)),LOOKUP(–MID(TEXT(A1,_frm),8,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),9,1)))&REPT(" ribu",(TEXT(A1,_frm)/10^3)>1),"satu ribu","seribu")&" "

&REPT("seratus ",–MID(TEXT(A1,_frm),10,1)=1)&REPT(INDEX(_huruf,1+MID(TEXT(A1,_frm),10,1)) &" ratus",–MID(TEXT(A1,_frm),10,1)>1)&" "
&IF(–MID(TEXT(A1,_frm),11,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),11,2)),LOOKUP(–MID(TEXT(A1,_frm),11,2),_angka,_huruf) & " "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),12,1))))&" rupiah "

&REPT(IF(–MID(TEXT(A1,_frm),14,2)<=19,INDEX(_huruf,1+MID(TEXT(A1,_frm),14,2)),LOOKUP(–MID(TEXT(A1,_frm),14,2),_angka,_huruf)&" "
&INDEX(_huruf,1+MID(TEXT(A1,_frm),15,1))) &" sen",–MID(TEXT(A1,_frm),14,2)>0)

Dengan metode atau cara yang sama bisa dikembangkan untuk konversi ke bahasa inggris atau bahasa lainnya.

==semoga bermanfaat==

April 30, 2017

The name ‘_’ already exist……

Filed under: Excel — cadex @ 08:34

The name already exist

Jika saat copy sheet Microsoft excel muncul pesan di atas, sehingga harus berkali-kali menekan tombol [Yes] berkali-kali.

Berikut solusinya:

  1. Sebelum copy sheet, aktifkan VBA Excel atau tekan tombol kombinasi [Alt+F8]
  2. Click [ThisWokbook], kemudian ketik vba code seperti dalam gambar:
  3. Names.PNG
  4. Letakkan kursor di bawah tulisan sub kemudian tekan [F5] untuk menjalankan vba
  5. Hapus VBA Code, bisa juga disimpan di notepad jika sewaktu-waktu dibutuhkan.
  6. Tutup VBA Editor atau tekan tombol kombinasai [Alt+Q]
  7. Pilih Menu [Formula], kemudian pilih [Name Manager]
  8. Name Manager
  9. Block semua Name, kemudian tekan [Delete] disusul dengan [Close]
  10. Lakukan copy sheet, maka pesan “the name already exist …” sudah tidak ada.

Trik ini juga bias digunakan apabila ada link ke external file yang tidak bias di putus (broken links)

Selamat mencoba

December 4, 2016

[XLS-SVY-24]: Plotting Cross section dari Excel ke Autocad Versi 1.2

Filed under: AutoCAD, Excel — Tags: , — cadex @ 14:40
Referensi : [XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1
Platform :  
Lokasi File : download

 

Tulisan ini adalah tindak lanjut dari beberapa comments/komentar dari posting [XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1. Walaupun tidak semua harapan pembaca terpenuhi

Perbaikan pada versi ini adalah :

  1. Nama program diganti dengan extensi *.xlam dan contoh file dalam format *.xlsx
  2. Mengganti menu dengan menggunakan “Custom UI Editor” sehingga menu baru ditampilkan dalam Ribbon Menu dan bisa di jalankan oleh Microsoft Excel 2007 ke atas.
  3. Merubah coding program menjadi metode “late binding” sehingga diharapkan program bisa dijalankan di Autocad 2000 ke atas tanpa harus setting Autocad Library.

Seperti halnya saat menjalankan program vba excel, pilih “Enable Macro” jika akan menggunakan program

Tampilan menu di Microsoft Excel 2016 :

image

Cara menjalankan program masih sama dengan tulisan pada [XLS-SVY-13]: Plotting Cross Section dari Excel ke AutoCAD Versi 1.1:

 

~~ selamat mencoba ~~

October 8, 2016

[CAD-LIS-02]: Autolisp untuk Membuat Pendekatan Lingkaran dari Beberapa Titik (Best Fitting Circle from Coordinates)

Filed under: AutoCAD, Tukang Ukur — Tags: — cadex @ 14:51
Referensi : [XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat
Lokasi File :  
Perangkat Lunak : Autocad

 

Pada tulisan [XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat, pusat dan jari-jari lingkaran dihitung dengan program excel dan hasilnya ditampilkand dalam bentuk chart excel.

Tulisan kali ini adalah aplikasinya dalam bentuk program autolisp, sehingga hasil hitungan pusat dan jari-jari lingkaran bisa langsung digambar di autocad dari titik-titik / object points yang sebelumnya sudah digambar di autocad.

Berikut list autolispnya:

(defun c:fc()
  ;menentukan batas pemilihan
  (setq p1 (getpoint));batas atas
  (setq p2 (getcorner p1));batas bawah

  ;dipilih hanya object bertype "POINT"
  (setq ss (ssget "_w" p1 p2 ‘((0 . "POINT")))) 
  (setq nPts (sslength ss));jumlah titik yang terplih

  ;jika jumlah titik >= 3 , maka akan diproses perhitungannya
  (if (>= nPts 3)
    (progn
      (setq idx 0)
      (setq ListX (list));list koordinat X
      (setq ListY (list));list koordinat Y
      ;memilah atau mengambil entity titik
      (setq SumX 0 SumY 0)
      (repeat nPts
    (setq ePt (entget (ssname ss idx)))
    (setq X (nth 1 (assoc 10 ePt)))
    (setq Y (nth 2 (assoc 10 ePt)))
    (setq ListX (append ListX (list X)))
    (setq ListY (append ListY (list Y)))

    (setq SumX (+ SumX X))
    (setq SumY (+ SumY Y))
    (setq idx (1+ idx))
    );repeat
      ;perhitungan least square
      (setq Xr (/ SumX nPts))
      (setq Yr (/ SumY nPts))
      (setq idx 0)
      (setq spp 0 sppp 0)
      (setq sqq 0 sqqq 0)
      (setq spq 0 spqq 0 sqpp 0)
      (repeat nPts
    (setq p (- (nth idx ListX) Xr))
    (setq q (- (nth idx ListY) Yr))
    (setq pp (* p p))   
    (setq ppp (* pp p))
    (setq qq (* q q))
    (setq qqq (* qq q))
    (setq pq (* p q))
    (setq pqq (* pq q))
    (setq qp (* q p))
    (setq qpp (* qp p))

    (setq spp (+ spp pp))
    (setq sppp (+ sppp ppp))
   
    (setq sqq (+ sqq qq))
    (setq sqqq (+ sqqq qqq))

    (setq spq (+ spq pq))
    (setq spqq (+ spqq pqq))
    (setq sqpp (+ sqpp qpp))

    (setq idx (1+ idx))
    );end repeat
      ;menghitung invers matrix A (2×2)
      ;|a11 a12| = |spp  spq|
       |a21 a21| = |spq  sqq|;

      (setq det (- (* spp sqq ) (* spq spq)))

      (setq a11 (/ sqq det))
      (setq a12 (/ (* -1.0 spq) det))     
      (setq a21 a12)
      (setq a22 (/ spp det))

      ;matrix L (2×1)
      (setq l11 (/ (+ spqq sppp) 2.0))
      (setq l21 (/ (+ sqqq sqpp) 2.0))

      (setq xx (+ (* a11 l11) (* a12 l21)))
      (setq yy (+ (* a21 l11) (* a22 l21)))

      ;koordinat pusat lingkaran
      (setq Xc (+ xx Xr))
      (setq Yc (+ yy Yr))
      (setq pc (list Xc Yc))

      (setq Sxx (+ (* xx xx) (* yy yy)))
      (setq r (+ sxx (/ (+ spp sqq) nPts)))

      ;jari-jari
      (setq r (sqrt r))
      (command "circle" pc r )
     
      );progn
    (alert "Number of points < 3 points")
    );if 
)

copy list tersebut, kemudian simpan dengan ekstensi .lsp atau download file.

Cara penggunaan program tersebut:

1. Pada ketik menu command:appload

2. Pilih file lisp atau file hasil download.

3. Misal lokasi titik yang akan dibuat lingkarannya adalah:

image

4. ketik pada menu command:fc

5. Kemudian select window mulai dari kiri atas sampai kanan bawah pada semua titik di atas.

6. Hasilnya:

image

#selamat mencoba

September 18, 2016

[XLS-SVY-23]: Spreadsheet Excel untuk Menentukan Pusat dan Jari-Jari Lingkaran dari Koordinat

Filed under: Excel — cadex @ 13:03
Referensi : Least-Squares Circle Fit by R. Bullock
Lokasi File : download
Platform : Microsoft Excel

Salah satu member di landsurveyorunited.com menanyakan program dalam spreadsheet excel untuk menentukan koordinat pusat lingkaran dan jari-jarinya dari hasil pengukuran minimal 3(tiga) koordinat di sepanjang lingkaran. Pengukuran semacam ini biasanya digunakan untuk menentukan as built tangki, pile ataupun untuk menentukan jari-jari kelengkungan suatu alignment horisontal.

Dari beberapa metode perhitungan, hitungan yang saya “anggap” paling mudah untuk diterapkan dalam spreadsheet excel adalah metode least square atau kuadrat terkecil yang ditulis oleh R. Bullock. Rumus dan tahapan perhitungan dalam spreadsheet akan mengacu ke rumus yang diuraikan dalam paper Least-Squares Circle Fit by R. Bullock

Mengacu ke contoh koordinat dalam paper tersebut, jika diplot dalam chart excel:

List Koordinat Chart di Excel
image image

Bentuk spreadsheet dalam excel dengan hasil hitungan dan chart:

image

Range Keterangan
[A6:A12] berisi nomer urut titik hasil ukuran
[B6:C12] Koordinat hasil pengukuran
[A4] Hitungan Jumlah titik pengukuran
[B4] Hiutngan Rata-rata koordinat X
[C4] Hitungan Rata-rata koordinat Y
[E:Z] Kolom tahapan perhitungan sesuai dengan paper R. Bullock
[D6] Hasil Koordinat X pusat lingkaran
[E6] Hasil Koordinat Y pusat lingkaran
[F6] Hasil jari-jari lingkaran

 

=silakan dicoba=

May 15, 2016

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

Filed under: Uncategorized — Tags: , — cadex @ 14:57
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”

April 12, 2016

[XLS-MAP-11]: Plotting Poligon dalam Koordinat TM3 ke Google Earth dengan Microsoft Excel

Filed under: Excel, Geodesy, Map, Tukang Ukur — Tags: , — cadex @ 22:24
Referensi : [XLS-MAP-10]: Plotting Koordinat UTM Ke Google Earth Dengan Microsoft Excel
Lokasi File :  
Platform : Microsoft Excel dan Google Earth
     

Pada posting sebelumnya telah diuraikan bagaimana cara memplot titik koordinat UTM ke Google Earth dengan menggunakan microsoft excel. Kali ini akan diuraikan bagaimana cara memplot jika koordinat tersebut dalam sistem proyeksi TM 3. Keterangan tentang sistem proyeksi TM3, silakan click link [CAD-MAP-05]: Proyeksi Koordinat Ke TM3 Di AutoCAD MAP atau [XLS-MAP-08]:14 Langkah Membuat Rumus Nomer Lembar TM3 Di Excel.

Misalkan list urutan poligon yang akan diplot adalah:

image

Berdasarkan pendekatan di google earth atau berdasarkan peta, lokasi koordinat geografis (koordinat lintang, bujur) tersebut terletak sekitar di 110derajat Bujur Timur dan 6derajat Lintang Selatan.

Silakan download file terlebih dahulu untuk mengikuti tahapan di bawah. Jika file suah terdownload dan file sudah dibuka:

  • Pada sheet [list] masukkan koordinat di atas. Delete baris di bawahnya jika sebelumnya ada list koordinatnya
  • Pindah ke sheet [Parameter], kemudian masukkan parameter untuk proyeksi TM3 sebagai berikut:

image

  • Pilih [Ellipsoid Reference]: WGS 84 dan [Map Projection] : TM3
  • Isikan [Longitude] atau bujur pendekatan 110
  • Isikan [Latitude] atau lintang pendekatan –6. Jika lintang pendekatan ada di lintang utara, maka masukkan tanpa tanda negatif.
  • pindah ke sheet [Grid2Geo] untuk melihat hasil perhitungan koordinat TM3 ke Geografis (Lintang,Bujur).
  • pindah ke sheet [point(xml)], kemudian hapus baris yang bertanda error #REF!
  • pindah ke sheet [polygon(xml)],kemudian hapus baris yang bertanda error #REF!
  • Apabila list koordindat lebih dari 4 titik, maka dapat dilakukan insert rows sesuai dengan jumlah titik. Sedangkan rumus pembentukan xml dapat dicopy dari rumus baris di atasnya
  • khusus untuk poligon, masukkan lagi koordinat terakhir=koordinat pertama
  • Pada sheet [point(xml)], `copy` range [G3:G10], kemudian `paste` ke notepad lalu simpan sebagai file kml. Misal nama filenya titik.kml
  • Pada sheet [polygon(xml)], `copy` range [E3:E17], kemudian `paste` ke notepad lalu simpan sebagai kml. Misal nama filenya : poligon.kml
  • Jalankan Google Earth
  • Pada menu [File], pilih [Open]
  • Pilih file [titik.kml] untuk menampilkan lokasi titik TM3.
  • Kemudian [Open] lagi file [poligon.kml] untuk menampilkan garis poligonnya
  • Setting properties polygon sesuai selera. Untuk contoh ini saya setting properties poligon di Google Earth:

image

 

  • Pilih tab [Measurement], maka didapat hitungan luas dan panjang kelilingnya

image

  • Hasil di google earth:

image

 

+selamat mencoba

January 1, 2016

[XLS-MAP-10]: Plotting Koordinat UTM ke Google Earth dengan Microsoft Excel

Filed under: Excel — Tags: , — cadex @ 02:04
Referensi :

[XLS-MAP-01]: Rumus Excel untuk Mencari Zone UTM dan TM3

[XLS-MAP-09]:Speadsheet Proyeksi Traverse Mercator di Excel (Versi #2)

Platform : Microsoft Excel, Google Earth
Lokasi File :  

 

Posting kali ini akan diuraikan cara mengeplot koordinat UTM ke dalam program google earth melalui file kml menggunakan program Microsoft Excel.

Program Microsoft Excel digunakan untuk merubah file koordinat UTM ke koordinat Lintang, Bujur kemudian berdasarkan koordinat Lintang, Bujur tersebut dibuatkan file KML yang dapat dibuka dengan program Google Earth.

Sebagai panduan langkah-langkah di bawah, silakan download file terlebih dahulu.

Contoh list koordinat UTM yang akan diplot:

image

Berikut adalah tahapan-tahapan yang saya lakukan:

1. Konversi Koordinat UTM ke Koordinat Geografis (Lintang, Bujur).

Rumus untuk merubah koordinat UTM ke Koordinat Geografis, menggunakan rumus yang telah diuraikan dalam [XLS-MAP-09]:Speadsheet Proyeksi Traverse Mercator di Excel (Versi #2).

Konversi atau proyeksi UTM ke Koordinat Geografis dengan asumsi menggunakan Ellipsoid Reference WGS 84, maka pada sheet [Parameters] dilakukan setting sebagai berikut:

image

[C2] Pilih WGS 84 Parameter a dan 1/f akan otomatis terisi
[C6] Pilih UTM Parameter proyeksi UTM akan terisi sendiri
[C14]   Masukkan koordinat Bujur pendekatan
[C15]   Masukkan koordinat Lintang pendekatan. Masukkan nilai negatif jika terletak di lintang selatan (South)

 

Setelah dilakukan setting parameter proyeksi, pindah ke sheet [Grid2Geo] untuk selanjutnya dilakukan proses proyeksi/konversi koordinat:

image

[A:C]   Masukkan koordinat UTM dengan urutan Nama Titik, East (X), North(Y)
     
[D8] =lat menghitung nilai Koordinat Lintang dalam satuan desimal
[E8] =lg menghitung Koordinat Bujur dalam satuan desimal
[F8] =gConv menghitung konvergensi grid dalam satuan desimal
[G8] =pntScale menghitung faktor skala titik
     
    copy rumus di [D8:G8] ke bawah sampai ke titik terakhir yang akan dihitung

2. Setting XML untuk plotting koordinat dalam bentuk titik.

Pindah ke sheet [point(xml)] untuk membuat file kml dam bentuk titik.

image

KML generator di atas akan membuat kumpulan titik dalam folder yang didefinisikan dalam cell [C4], nama titik dan koordinatnya dimulai dari cell [C6] dan cells [E6] sampai titik yang diinginkan. Cells yang berwarna kuning adalah cells yang berisi rumus atau formula dengan menggunakan referensi [Grid2Geo].

image

KML generator di atas akan membuat kumpulan titik dalam folder yang didefinisikan dalam cell [C4], nama titik dan koordinatnya dimulai dari cell [C6] dan cells [E6] sampai titik yang diinginkan. Cells yang berwarna kuning adalah cells yang berisi rumus atau formula dengan menggunakan referensi [Grid2Geo]. Sedangkan text dalam kolom G atau kolom XML adalah file KML yang akan diexport atau dibaca oleh Google Earth.

Rumus yang disgunakan dalam worksheet [point(xml)]:

[C4]   Masukkan nama group atau folder titik
[C6] =Grid2Geo!A8 mengambil point desc dari sheet [Grid2Geo] sebagai nama placemark
[E6] =TEXT(Grid2Geo!E8,"0."&REPT("0","14"))&","&TEXT(Grid2Geo!D8,"0."&REPT("0","14"))&","&TEXT(list!D2,"0.00") memformat koordinat Bujur, Lintang dari sheet [Grid2Geo] dalam unit desimal dengan format 14 digit desimal
[G6] =B6&C6&D6&E6&F6 Menggabungkan text di kolom B, c d e dan F
     
    copy rumus di [A6:G6] sampai ke titik terakhir di sheet [Grid2Geo]
[G19] </Folder> jangan lupa akhiri dengan text </Folder>

3. Membukan file KML di Google Earth.

[G3:G19]   Block range [G3:G19]>> kemudian click kanan>>Copy

Jalankan program note pad, kemudian paste hasil copy dari excel

Kemudian simpan notepad dengan extensi kml. Misal disimpan dengan nama [titik.kml]

image

Jalankan program Google Earth kemudian bukan file [titik.kml]

Untuk kumpulan titik yang berbentuk polygon tertutuo silakan dicoba template di sheet [polygon(xml)].

 

===terimakasih telah berkunjung di blog saya===

December 25, 2015

Filed under: Excel — cadex @ 22:45

Older Posts »

Create a free website or blog at WordPress.com.