Tugas Ke-4 (Cafe Of Yunfa)

Programnya :

Listingnya :

Private Sub Cmdclear_Click()
Option1 = False
Option2 = False
Check1 = False
Check2 = False
List1.Clear
Txthrgmenu = ""
Txthrgfasilitas = ""
Txthrgminum = ""
Txtjumbel = ""
Txtubay = ""
Txttotbay = ""
Txtukem = ""
Cmbmenu.Clear
Cmbpaket.Clear
End Sub

Private Sub Cmdkeluar_Click()
x = MsgBox("Get Out?", vbQuestion + vbOKCancel, "Konfirmasi")
If x = vbOK Then
End
End If
End Sub

Private Sub Form_Load()
Cmbmenu.AddItem ("Sarapan Pagi")
Cmbmenu.AddItem ("Makan Siang")
Cmbpaket.AddItem ("Paket 1")
Cmbpaket.AddItem ("Paket 2")

End Sub

Private Sub Check1_Click()
If Check1 = 1 And Check2 = 1 Then
Txthrgminum = 3000
ElseIf Check1 = 1 And Check2 = 0 Then
Txthrgminum = 2500
ElseIf Check1 = 0 And Check2 = 1 Then
Txthrgminum = 500
Else
Txthrgminum = 0
End If

End Sub

Private Sub Check2_Click()
If Check1 = 1 And Check2 = 1 Then
Txthrgminum = 3000
ElseIf Check1 = 1 And Check2 = 0 Then
Txthrgminum = 2500
ElseIf Check1 = 0 And Check2 = 1 Then
Txthrgminum = 500
Else
Txthrgminum = 0
End If

End Sub

Private Sub Cmbpaket_Click()
If Cmbmenu.Text = "Sarapan Pagi" Then
Select Case (Cmbpaket.Text)
Case "Paket 1"
List1.Clear
List1.AddItem ("Nasi Uduk")
List1.AddItem ("Telur")
List1.AddItem ("Tempe Orek")
Txthrgmenu = 5000
Case Else
List1.Clear
List1.AddItem ("Nasi Goreng")
List1.AddItem ("Telur Mata Sapi")
List1.AddItem ("Tempe goreng")
Txthrgmenu = 7000
End Select
Else
Select Case (Cmbpaket.Text)
Case "Paket 1"
List1.Clear
List1.AddItem ("Nasi Putih")
List1.AddItem ("Ayam Bakar")
List1.AddItem ("Lalapan")
Txthrgmenu = 8000
Case Else
List1.Clear
List1.AddItem ("Nasi Putih")
List1.AddItem ("Rendang")
List1.AddItem ("Sayur")
List1.AddItem ("Sambal Ijo")
Txthrgmenu = 10000
End Select
End If

End Sub

Private Sub Option1_Click()
Txthrgfasilitas = 5000

End Sub

Private Sub Option2_Click()
Txthrgfasilitas = 0

End Sub

Private Sub Txtjumbel_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Txttotbay = Val(Txtjumbel) * (Val(Txthrgmenu) + Val(Txthrgfasilitas) + Val(Txthrgminum))
Txtubay.SetFocus
End If

End Sub

Private Sub Txtubay_Change()
Txtukem = Val(Txtubay) - (Txttotbay)

End Sub

Cara Membuat Daftar Isi Sitemap Blog Otomatis

Berikut ini cara membuat daftar isi/sitemap di blog secara otomatis :

1.       Login ke akun blogger anda.

2.       Pilih Entri Baru (New Post) > Edit HTML.

3.       Copy salah satu script sitemap yang mau dipakai dibawah ini dan paste pada area posting.

Script 1 :

<script src="http://jarlok.com/Script/Sitemap.js">

</script> <script src="http://nama-blog-anda.blogspot.com/feeds/posts/default?max-results=500&amp;alt=json-in-script&amp;callback=loadtoc">

</script>

Script 2 :

<link href="http://abu-farhan.com/script/acctoc/acc-toc.css" media="screen" rel="stylesheet" type="text/css"></link>

<script src="http://abu-farhan.com/script/acctoc/daftarisiv2-pack.js"></script>

<script src="http://nama-blog-anda.blogspot.com/feeds/posts/summary?max-results=1000&amp;alt=json-in-script&amp;callback=loadtoc"></script>

<script type="text/javascript">

var accToc=true;

</script>

<script src="http://abu-farhan.com/script/acctoc/accordion-pack.js" type="text/javascript"></script>

4.       Klik Terbitkan Entri dan lihat hasilnya.

Tugas Ke-3 (Perulangan)

Programnya :

Listingnya :
Private Sub Cmdclear_Click()
List1.Clear
Cmbtgl.Clear
Cmbbln.Clear
Cmbthn.Clear
End Sub

Private Sub Cmddountil_Click()
List1.Clear
i = 1
Do Until i > 5
List1.AddItem (i)
i = i + 1
Loop
End Sub

Private Sub Cmddowhile_Click()
List1.Clear
i = 10
Do While i > 6
List1.AddItem (i)
i = i - 1
Loop
End Sub

Private Sub cmdfornext_Click()
List1.Clear
Dim a As Integer
a = 1
jumlah = 0
For i = 1 To 10
List1.AddItem (i)
jumlah = jumlah + a
a = a + 2
Next
End Sub

Private Sub Cmdkeluar_Click()
Irna = MsgBox("Anda Yakin Ingin Keluar dari Program Ini?", vbQuestion + vbOKCancel, "Konfirmasi")
End
End Sub

Private Sub Cmdwhilewent_Click()
List1.Clear
i = 20
While i <= 60
List1.AddItem (i)
i = i + 10
Wend
End Sub

Private Sub Form_Load()
For i = 1 To 31
Me.Cmbtgl.AddItem (Str(i))
Next i
For i = 1 To 12
Me.Cmbbln.AddItem (MonthName(i))
Next i
For i = 1990 To Year(Now)
Me.Cmbthn.AddItem (Str(i))
Next i
End Sub

Tugas Ke-2 (Percabangan)

Programnya :

Listingnya :

Private Sub CmdBersih_Click()
Me.TxtAbsen = ""
Me.TxtTgs = ""
Me.TxtUts = ""
Me.TxtUas = ""
Me.habsen = ""
Me.Htgs = ""
Me.Huts = ""
Me.Huas = ""
Me.TxtTotNil = ""
Me.TxtGrade = ""
Me.TxtKet = ""
End Sub

Private Sub CmdHitung_Click()
'Menghitung Total Nilai
TxtTotNil = Val(habsen.Text) + Val(Htgs.Text) + Val(Huts.Text) + Val(Huas.Text)
'menghitung grade
If TxtTotNil >= 80 And TxtTotNil <= 100 Then
TxtGrade = "A"
Else
If TxtTotNil >= 69 And TxtTotNil <= 79 Then
TxtGrade = "B"
Else
If TxtTotNil >= 56 And TxtTotNil <= 68 Then
TxtGrade = "C"
Else
If TxtTotNil >= 40 And TxtTotNil <= 55 Then
TxtGrade = "D"
Else
TxtGrade = "E"
End If
End If
End If
End If
'Menghitung keterangan
If TxtGrade = "A" Or TxtGrade = "B" Or TxtGrade = "C" Then
TxtKet = "LULUS"
Else
TxtKet = "GAGAL"
End If
End Sub

Private Sub CmdKeluar_Click()
a = MsgBox("Yakin Anda Mau Keluar dari Form ini?", vbQuestion + vbOKCancel, "Tanya")
If a = vbOK Then
End
End If
End Sub

Private Sub TxtAbsen_Change()
habsen = 0.1 * Val(TxtAbsen)
End Sub

Private Sub TxtTgs_Change()
Htgs = 0.2 * Val(TxtTgs)
End Sub

Private Sub TxtUas_Change()
Huas = 0.4 * Val(TxtUas)
End Sub

Private Sub TxtUts_Change()
Huts = 0.3 * Val(TxtUts)
End Sub