FORM VBA EXCEL UNTUK PERHITUNGAN ARAH QIBLAT

Bukalah Ms Excel dan bukalah editor VBA nya, kemudian buatlah form seperti tampak berikut ini :

 kembalilah ke MS Excel

Rename  sheet 1 menjadi  AWWAL dan sheet2 menjadi TSANI

kode form di atas adalah sebagai berikut

Private Sub CMDHT_Click()

Dim iRow As Long

Dim ws As Worksheet

Set ws = Worksheets("TSANI")

'menemukan baris kosong pada database

iRow = ws.Cells(Rows.Count, 1) _

  .End(xlUp).Offset(1, 0).Row

'check untuk sebuah kota

If Trim(Me.TKOTA.Value) = "" Then

  Me.TKOTA.SetFocus

  MsgBox "NAMA KOTANYA GUS"

  Exit Sub

End If

KOTA = Me.TKOTA.Value

'memasukkan dalam variabel

DLIN = Me.TDL.Value

MLIN = Me.TML.Value

SLIN = Me.TSL.Value

'mengubah menjadi desimal

lintang = Abs(DLIN) + MLIN / 60 + SLIN / 3600

If DLIN < 0 Then

lintang = lintang * -1

lintang = lintang

End If

'mengubah menjadi DMS

LINTANGDMS = DMS(lintang)

'memasukkan dalam variabel

DBU = Me.TDB.Value

MBU = Me.TMB.Value

SBU = Me.TSB.Value

'mengubah menjadi desimal

bujur = Abs(DBU) + MBU / 60 + SBU / 3600

If DBU < 0 Then

bujur = bujur * -1

bujur = bujur

End If

'mengubah menjadi DMS

BUJURDMS = DMS(bujur)

'perhitungan arah qiblat

Pi = Application.Pi()

r = 180 / Pi

lintangmakkah = 21 + 25 / 60 + 14 / 3600

bujurmakkah = 39 + 49 / 60 + 41 / 3600

'PENGUJUIAN POSISI I

If bujur = bujurmakkah Then

        Select Case lintang

        Case Is = lintangmakkah

        QIBLATK = "KA'BAH SENDIRI"

        ket1 = ""

        ket2 = ""

       

        Case Is > lintangmakkah

        QIBLATK = "SELATAN"

        ket1 = ""

        ket2 = ""

        Case Else

        QIBLATK = "UTARA"

        ket1 = ""

        ket2 = ""

        End Select

       

   

ElseIf bujur = bujurmakkah + 180 - 360 Then

        Select Case lintang

        Case Is = -lintangmakkah

        QIBLATK = "SEGALA ARAH"

        ket1 = ""

        ket2 = ""

        Case Is < -lintangmakkah

        QIBLATK = "SELATAN"

        ket1 = ""

        ket2 = ""

        Case Else

        QIBLATK = "UTARA"

        ket1 = ""

        ket2 = ""

        End Select

Else

selisihbujur = bujurmakkah - bujur

jarakr = Application.Acos(Cos(lintang / r) * Cos(lintangmakkah / r) * Cos(selisihbujur / r) + Sin(lintang / r) * Sin(lintangmakkah / r))

jarak = jarakr * r

qiblatr = Application.Asin((Sin(lintangmakkah / r) - Cos(jarakr) * Sin(lintang / r)) / (Cos(lintang / r) * Sin(jarakr)))

QIBLATDES = qiblatr * r

QIBLATK = DMS(QIBLATDES)

End If

'PENGUJIAN POSISI II

'TEPAT ARAH BARAT/TIMUR

BTr = Atn(Tan(lintangmakkah / r) / Cos(selisihbujur / r))

BT = BTr * r

If bujur > bujurmakkah Then

ket1 = "BARAT - "

Else

ket1 = "TIMUR - "

End If

If lintang > BT Then

ket2 = "SELATAN"

Else

ket2 = "UTARA"

End If

URUT = iRow - 2

'copy data ke database

ws.Cells(iRow, 1).Value = URUT

ws.Cells(iRow, 2).Value = KOTA

ws.Cells(iRow, 3).Value = LINTANGDMS

ws.Cells(iRow, 4).Value = BUJURDMS

ws.Cells(iRow, 5).Value = QIBLATK & " " & ket1 & ket2

MsgBox "QIBLAT " & KOTA & " ADALAH :" & QIBLATK & " " & ket1 & ket2

Sheets("TSANI").Select

'clear data

Me.TKOTA.Value = ""

Me.TDL.Value = ""

Me.TML.Value = ""

Me.TSL.Value = ""

Me.TDB.Value = ""

Me.TMB.Value = ""

Me.TSB.Value = ""

Me.TKOTA.SetFocus

End Sub

Private Sub CMDTTP_Click()

   Sheets("AWWAL").Select

   MsgBox " Alhamdulillah"

     Unload Me

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _

  CloseMode As Integer)

  If CloseMode = vbFormControlMenu Then

    Cancel = True

    MsgBox "MAKE TOMBOL AJA YA GUS!"

  End If

End Sub

'fungsi dms

Function DMS(y)

x = Abs(y)

derajat = Int(x)

If y < 0 Then

derajat = derajat * -1

derajat = derajat

End If

menit = Int(60 * x) Mod 60

sekonasal = 3600 * x

sekonutuh = Int(sekonasal)

sekonpecah = Round((sekonasal - sekonutuh), 2)

sekon = sekonutuh Mod 60 + sekonpecah

DMS = derajat & Chr(176) & " " & menit & Chr(39) & " " & sekon & Chr(34)

End Function

kemudian kembali ke MS Excel buatlah tombol commaand Button untuk mrmunculkan form di atas dengan kode sebagai berikut :

Private Sub CMDMULAI_Click()
MsgBox "bismillaahirrohmanirrohiim"
UserForm1.Show
End Sub

untuk file nya silakan download di :

http://www.4shared.com/rar/BVDU_aCq/QIBLATFORM.html

FUNGSI VBA EXCEL UNTUK KONVERSI TANGGAL

Berikut beberapa kode vba Excel untuk konversi tanggal Miladiyah ke Hijriyah , Jawi Islam ataupun sebaliknya.

Fungsi konversi tanggal miladiyah ke Julian Day

Function milaju(x, y, z)

Dim tahun, bul1, bul, tgl

Dim satu, tah, jjd, gjd, jul

If x = 0 Then MsgBox "Tidak ada Tahun Nol Gus "

If x < 0 Then

tahun = x + 1

Else

tahun = x

End If

bul1 = y

tgl = z

satu = Int((14 - bul1) / 12)

tah = tahun + 4800 - satu

bul = bul1 + 12 * satu - 3

jjd = tgl + Int((153 * bul + 2) / 5) + tah * 365 + Int(tah / 4) - 32083

gjd = tgl + Int((153 * bul + 2) / 5) + tah * 365 + Int(tah / 4) - Int(tah / 100) + Int(tah / 400) - 32045

If jjd > 2299159.5 Then

jul = gjd

Else

jul = jjd

End If

milaju = jul

End Function

Fungsi konversi tanggal Hijriyah urfi ke Julian Day

Function hijiju(x, y, z)

Dim tah, tahun, bul, tgl, hari

If x = 0 Then MsgBox "Tidak ada Tahun Nol Gus "

If x < 0 Then

tahun = x + 1

Else

tahun = x

End If

tah = tahun + 5498

bul = y

tgl = z

hari = Int((354 + 11 / 30) * tah - 353.85) + Int(29.5 * bul - 29) + tgl

hijiju = hari + 131

End Function

Fungsi konversi tanggal Jawi Islam ke Julian Day

Function jawijul(x, y, z)

Dim hari, jum, kor, t

If x >= 1627 And x <= 1674 Then

t = x + 5

hari = Int(t * 354.375 + 0.3) + Int(29.5 * y - 29) + z

kor = Int(t / 120)

jum = hari - kor + 1764877

Else

t = x + 53

hari = Int(t * 354.375 + 0.3) + Int(29.5 * y - 29) + z

kor = Int(t / 120)

jum = hari - kor + 1747867

End If

jawijul = jum

End Function

Fungsi konversi Julian Day ke tanggal Miladiyah

Function jumila(x)

Dim ctr0, ctr1, ctr2, ctr3, ctr4, ctr5, ctr6

Dim tanggal, bulan, tahun1, tahun, bln

Dim hari, pasaran, hr, ps

ctr0 = x

ctr1 = x + 32044

If ctr0 > 2299159.5 Then

ctr2 = Int((4 * ctr1 + 3) / 146097)

Else

ctr2 = 0

End If

If ctr0 > 2299159.5 Then

ctr3 = ctr1 - Int((ctr2 * 146097) / 4)

Else

ctr3 = ctr0 + 32082

End If

ctr4 = Int((4 * ctr3 + 3) / 1461)

ctr5 = ctr3 - Int((1461 * ctr4) / 4)

ctr6 = Int((5 * ctr5 + 2) / 153)

tanggal = ctr5 - Int((153 * ctr6 + 2) / 5) + 1

bulan = ctr6 + 3 - 12 * Int(ctr6 / 10)

tahun1 = ctr2 * 100 + ctr4 - 4800 + Int(ctr6 / 10)

If tahun1 < 1 Then

tahun = tahun1 - 1

Else

tahun = tahun1

End If

Select Case bulan

Case Is = 1

bln = "Januari"

Case Is = 2

bln = "Pebruari"

Case Is = 3

bln = "Maret"

Case Is = 4

bln = "April"

Case Is = 5

bln = "Mei"

Case Is = 6

bln = "Juni"

Case Is = 7

bln = "Juli"

Case Is = 8

bln = "Agustus"

Case Is = 9

bln = "September"

Case Is = 10

bln = "Oktober"

Case Is = 11

bln = "Nopember"

Case Is = 12

bln = "Desember"

End Select

hr = (ctr0 + 2) Mod 7

ps = (ctr0 + 1) Mod 5

Select Case hr

Case Is = 1

hari = "Ahad"

Case Is = 2

hari = "Senin"

Case Is = 3

hari = "Selasa"

Case Is = 4

hari = "Rabu"

Case Is = 5

hari = "Kamis"

Case Is = 6

hari = "Jum'at"

Case Is = 0

hari = "Sabtu"

End Select

Select Case ps

Case Is = 1

pasaran = "Legi"

Case Is = 2

pasaran = "Pahing"

Case Is = 3

pasaran = "Pon"

Case Is = 4

pasaran = "Wage"

Case Is = 0

pasaran = "Kliwon"

End Select

jumila = hari & " " & pasaran & " " & tanggal & " " & bln & " " & tahun

End Function

Fungsi konversi Julian Day ke tanggal Hijri Urfi

Function juhiji(x)

Dim tahun, sisa, s1, bulan, tanggal, bln, hr, ps, hari7, hari, pasaran

hari = x - 131

tahun = Int(hari * 3 / 1063.1) + 1

s1 = Int(tahun * 1063.1 / 3 - 353.85)

sisa = hari - s1

If sisa = 0 Then

tahun = Int(hari * 3 / 1063.1)

s1 = Int(tahun * 1063.1 / 3 - 353.85)

sisa = hari - s1

Else

tahun = tahun

sisa = sisa

End If

tahun = tahun

sisa = sisa

bulan = Int(sisa / 29.5 + 0.97)

If bulan > 12 Then bulan = 12

tanggal = sisa - Int(29.5 * bulan - 29)

tahun = tahun - 5498

If tahun < 1 Then

tahun = tahun - 1

Else

tahun = tahun

End If

Select Case bulan

Case Is = 1

bln = "Muharrom"

Case Is = 2

bln = "Shofar"

Case Is = 3

bln = "Robi'ul Awwal"

Case Is = 4

bln = "Robi'uts Tsani"

Case Is = 5

bln = "Jumadil Ula"

Case Is = 6

bln = "Jumadits Tsani"

Case Is = 7

bln = "Rojab"

Case Is = 8

bln = "Sya'ban"

Case Is = 9

bln = "Romadlon"

Case Is = 10

bln = "Syawwal"

Case Is = 11

bln = "Dzul Qo'dah"

Case Is = 12

bln = "Dzul Hijjah"

End Select

hr = (x + 2) Mod 7

ps = (x + 1) Mod 5

Select Case hr

Case Is = 1

hari7 = "Ahad"

Case Is = 2

hari7 = "Senin"

Case Is = 3

hari7 = "Selasa"

Case Is = 4

hari7 = "Rabu"

Case Is = 5

hari7 = "Kamis"

Case Is = 6

hari7 = "Jum'at"

Case Is = 0

hari7 = "Sabtu"

End Select

Select Case ps

Case Is = 1

pasaran = "Legi"

Case Is = 2

pasaran = "Pahing"

Case Is = 3

pasaran = "Pon"

Case Is = 4

pasaran = "Wage"

Case Is = 0

pasaran = "Kliwon"

End Select

juhiji = hari7 & " " & pasaran & " " & tanggal & " " & bln & " " & tahun

End Function

Fungsi konversi Julian Day ke tanggal Jawi Islam

Function juljawi(y)

Dim t, h, s, x, t1, h1, tahun, bulan, bln, tanggal

Dim sisa, hri, hari, hari7, ps, pasaran

Dim huruf, huruf1, huruf2, huruf3, huruf4, huruf5, huruf6

If y >= 2343204 And y <= 2360213 Then

x = y - 1747867

x = x - 7 * 2835

h = x + Int(x / 42524)

t = Int((354 + h) / 354.375) - 1

h1 = Int((t) * 354.375 + 0.3)

tahun = t + 3

sisa = h - h1

huruf2 = Int((tahun + 55) / 120) + 17

Else

x = y - 1747867

h = x + Int(x / 42524)

t = Int((354 + h) / 354.375) - 1

h1 = Int((t) * 354.375 + 0.3)

tahun = t - 53

sisa = h - h1

huruf2 = Int((tahun + 53) / 120) + 18

End If

If tahun < 1 Then

tahun = tahun - 1

Else

tahun = tahun

End If

bulan = Int(sisa / 29.5 + 0.97)

If bulan > 12 Then bulan = 12

tanggal = sisa - Int(29.5 * bulan - 29)

Select Case bulan

Case Is = 1

bln = "Sura"

Case Is = 2

bln = "Sapar"

Case Is = 3

bln = "Mulud"

Case Is = 4

bln = "Bakda Mulud"

Case Is = 5

bln = "Jumadilawal"

Case Is = 6

bln = "Jumadilakir"

Case Is = 7

bln = "Rejeb"

Case Is = 8

bln = "Ruwah"

Case Is = 9

bln = "Pasa"

Case Is = 10

bln = "Syawal"

Case Is = 11

bln = "Dulkangidah"

Case Is = 12

bln = "Besar"

End Select

hri = (x + 4) Mod 7

ps = (x + 3) Mod 5

Select Case hri

Case Is = 1

hari7 = "Ahad"

Case Is = 2

hari7 = "Senen"

Case Is = 3

hari7 = "Selasa"

Case Is = 4

hari7 = "Rebo"

Case Is = 5

hari7 = "Kemis"

Case Is = 6

hari7 = "Jumungah"

Case Is = 0

hari7 = "Setu"

End Select

Select Case ps

Case Is = 1

pasaran = "Legi"

Case Is = 2

pasaran = "Pahing"

Case Is = 3

pasaran = "Pon"

Case Is = 4

pasaran = "Wage"

Case Is = 0

pasaran = "Kliwon"

End Select

huruf = tahun Mod 8

Select Case huruf

Case Is = 1

huruf1 = "Wawu"

Case Is = 2

huruf1 = "Jim Akir"

Case Is = 3

huruf1 = "Alip"

Case Is = 4

huruf1 = "Ehe"

Case Is = 5

huruf1 = "Jim Awal"

Case Is = 6

huruf1 = "Ze"

Case Is = 7

huruf1 = "Dal"

Case Is = 0

huruf1 = "Be"

End Select

huruf3 = huruf2 Mod 7

huruf4 = huruf2 Mod 5

Select Case huruf3

Case Is = 1

huruf5 = "Angad"

Case Is = 2

huruf5 = "Atu"

Case Is = 3

huruf5 = "Angah"

Case Is = 4

huruf5 = "Amis"

Case Is = 5

huruf5 = "Abo"

Case Is = 6

huruf5 = "Asa"

Case Is = 0

huruf5 = "Anen"

End Select

Select Case huruf4

Case Is = 1

huruf6 = "gi"

Case Is = 2

huruf6 = "won"

Case Is = 3

huruf6 = "ge"

Case Is = 4

huruf6 = "pon"

Case Is = 0

huruf6 = "ing:"

End Select

juljawi = hari7 & " " & pasaran & " " & tanggal & " " & bln & " " & tahun & " " & huruf1 & " " & huruf5 & huruf6

End Function

Contoh file silakan download di :

http://liekwasil.mywapblog.com/files/konversi.rar

JALAN KERBAU

Alkisah ada seorang petani.
Hidup di desa pinngir hutan lereng sebuah gunung.
Pak tani mempunyai seekor anak kerbau.
Tiap hari digiring ke sungai untuk dimandikan.

Awalnya yang dilewati adalah semak-semak.
Rumput-rumput terinjak kaki sang kerbau.
kemudian jadi jalan setapak.

Jalan itu makin lebar.
Tetangga pak tani ikut melewatinya.

Beberapa tahun kemudian
Warga desa bekerja giat.
Desanya makin maju.

Datang pemodal dari kota.
Dibawa oleh Pak Kepala Desa.
Desa itu dibangun, jalan pinggir desa juga dibangun.
Jalan itu sudah bukan jalan setapak lagi.
Di atas kalipun sudah ada jembatan.
Makin banyak orang yang lewat.

Tetangga Pak tani pergi ke kantor lewat jalan itu.
Anak-anak sekolah lewat jalan itu.
Pedagang keliling, tukan rentenir juga lewat jalan itu,
Tahun kemarin bapak bupati juga lewat jalan itu.
Semua orang lewat jalan itu

Kerbau pak tani sudah jarang lewat jalan itu.
Kerbau pak tani makin tua.
Sudah tidak membajak sawah lagi.
Kerbau disembelih. Untuk upacara syukuran desa.
Sekaligus meresmikan nama jalan itu.
“Jalan Kerbau” nama jalan itu, untuk mengenang kerbaunya.
Itu usul pak tani sesepuh desa itu yang paling sepuh.
Pak lurah setuju, tetua-tetua desa setuju. Pak RT setuju.
Pak Camat setuju, pak Bupatipun setuju.
Seluruh warga ikut bangga.
Jalan itu makin terkenal hingga luar desa bahkan luar kota.

Ekonomi warga makin maju.
Itulah berkah jalan itu.
Seluruh warga percaya akan hal itu.
Warga desa akhirnya mengkeramatkan jalan itu.
Pak RT mengkeramatkan jaln itu.
Tetua desa, Pak lurah Pak Camat Pak bupati mengkeramatkan jalan itu.

Tiap tahun didakan uapcara sesaji
Warga desa membuat sesaji.
Membawa dupa dan bunga.
Pak RT membawa sesaji
Pak Lurah membawa sesaji
Pak camat membawa sesaji
Pak Bupati membawa sesaji
Para pelajar membawa sesaji
Mahasiswa membawa sesaji
Tokoh agama membawa sesaji
Para pengusaha membawa sesaji
Semua orang membawa sesaji.
Pak Tani memimpin upacara
Dia tidak membawa sesaji.
Pak tani bercerita pada cucunya.
Menceritakan jalan kerbaunya.
“Semua orang ternyata dungu.
Mereka tak pernah membuat jalan sendiri.
Walau kini kerbau kita sudah pernah lewat.
Tetap saja jalan itu itu jalan kerbau”
 Yogyakarta, 12 November 2010.