Tugas Visual Basic

Private Sub chkBold_Click()
'Font Tebal
If chkBold.Value = 1 Then
lblTeks.FontBold = True
Else
lblTeks.FontBold = False
End If
End Sub

Private Sub chkItalic_Click()
'Font Italic
If chkItalic.Value = 1 Then
lblTeks.FontItalic = True
Else
lblTeks.FontItalic = False
End If
End Sub

Private Sub chkStrikeout_Click()
'Font Strikeout
If chkStrikeout.Value = 1 Then
lblTeks.FontStrikethru = True
Else
lblTeks.FontStrikethru = False
End If
End Sub

Private Sub chkUnderline_Click()
'Font Underline
If chkUnderline.Value = 1 Then
lblTeks.FontUnderline = True
Else
lblTeks.FontUnderline = False
End If
End Sub

Private Sub optBlue_Click()
'Font Biru
lblTeks.ForeColor = vbBlue

End Sub

Private Sub optGreen_Click()
'Font Hijau
lblTeks.ForeColor = vbGreen
End Sub

Private Sub optRed_Click()
'Font Merah
lblTeks.ForeColor = vbRed
End Sub

Private Sub optYellow_Click()
'Font Kuning
lblTeks.ForeColor = vbYellow

End Sub


Private Sub CboNpm_Click()
Dim Mhs, Jrs, HM As String
Select Case CboNpm.Text
Case "11100042"
Mhs = "FITRIYANI"
Jrs = "SISTEM INFORMASI"
Case "11200077"
Mhs = "PUSPITA DESI"
Jrs = "MANAJEMEN INFORMATIKA"
Case "11300078"
Mhs = "SEPTIANA"
Jrs = "TEHNIK INFORMATIKA"
Case "11100079"
Mhs = "TOTO ISWANTO"
Jrs = "SISTEM INFORMATIKA"
Case "11200081"
Mhs = "SUPRAPTO"
Jrs = "MANAJEMEN INFORMATIKA"
Case "11300082"
Mhs = "NOVI SUSANTI"
Jrs = "TEHNIK INFORMATIKA"
Case "11100084"
Mhs = "SUKMAWATI"
Jrs = "SISTEM INFORMATIKA"
Case "11200085"
Mhs = "LENI APRIYANI"
Jrs = "MANAJEMEN INFORMATIKA"
Case "11300086"
Mhs = "NURMALITA SARI"
Jrs = "TEHNIK INFORMATIKA"
Case "11100087"
Mhs = "HENI LESTARI"
Jrs = "SISTEM INFORMATIKA"
End Select
txtMhs.Text = Mhs
txtJrs.Text = Jrs
txtQs.SetFocus
End Sub

Private Sub cmdBatal_Click()
CboNpm.SetFocus
CboNpm.Text = ""
txtMhs.Text = ""
txtJrs.Text = ""
txtQs.Text = ""
txtTgs.Text = ""
txtUts.Text = ""
txtUas.Text = ""
txtAkhir.Text = ""
txtHm.Text = ""
End Sub

Private Sub cmdKeluar_Click()
End
End Sub

Private Sub cmdProses_Click()
Dim NA As Integer
Dim HM As String
QUIS = Val(txtQs.Text)
TUGAS = Val(txtTgs.Text)
UTS = Val(txtUts.Text)
UAS = Val(txtUas.Text)
NA = (QUIS + TUGAS + UTS + UAS) / 4
txtAkhir.Text = NA

Select Case txtAkhir.Text
Case Is >= 80
HM = "A"
Case Is >= 70
HM = "B"
Case Is >= 60
HM = "C"
Case Is >= 50
HM = "D"
Case Is < 49
HM = "E"
End Select
txtHm.Text = HM
End Sub


Private Sub Form_Load()
CboNpm.AddItem "11100042"
CboNpm.AddItem "11200077"
CboNpm.AddItem "11300078"
CboNpm.AddItem "11100079"
CboNpm.AddItem "11200081"
CboNpm.AddItem "11300082"
CboNpm.AddItem "11100084"
CboNpm.AddItem "11200085"
CboNpm.AddItem "11300086"
CboNpm.AddItem "11100087"
End Sub



Private Sub txtQs_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTgs.SetFocus
End If
End Sub



Private Sub txtTgs_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtUts.SetFocus
End If
End Sub



Private Sub txtUts_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtUas.SetFocus
End If
End Sub


Private Sub cmdHit_Click()
Dim A, B, C As Double
A = txtHgawal.Text
B = (txtHgawal) * 0.1
Hasil = A - B
txtDisk.Text = B
txtHgakhir.Text = Hasil
End Sub

Private Sub cmdKlr_Click()
End
End Sub

Private Sub cmdUlg_Click()
txtHgawal.SetFocus
txtHgawal.Text = ""
txtDisk.Text = ""
txtHgakhir.Text = ""
End Sub


Private Sub cmdKeluar_Click()
End
End Sub

Private Sub cmdProses_Click()
Dim Gapok, Tj, Pt, Gk, Pjk, Gjtrm As Double
txtGk.Text = Val(txtgapok.Text) + Val(txtTj.Text) - Val(txtPt.Text)
txtPjk.Text = Val(txtGk.Text) * (0.1)
TxtGjtrm.Text = Val(txtGk.Text) - (txtPjk.Text)
End Sub
Private Sub cmdUlang_Click()
txtgapok.SetFocus
txtgapok.Text = ""
txtTj.Text = ""
txtPt.Text = ""
txtGk.Text = ""
txtPjk.Text = ""
TxtGjtrm.Text = ""
End Sub

Private Sub txtgapok_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTj.SetFocus
End If
End Sub

Private Sub txtTj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtPt.SetFocus
End If

End Sub


Private Sub cmdKeluar_Click()
'keluar
End
End Sub

Private Sub cmdLagi_Click()
'kosongkan semua isi by benk2
txtKt.Text = ""
txtHt.Text = ""
txtJk.Text = ""
txtJb.Text = ""
txtJt.Text = ""
txtTp.Text = ""
 txtTerbilang.Text= ""
txtKt.SetFocus
End Sub

Private Sub cmdProses_Click()
Dim Kt As String
Kt = Left(txtKt, 3)
If Kt = "BIM" Then
txtHt.Text = "50000"
txtJk.Text = "BIMA"
txtJb.Text = "16.00"
ElseIf Kt = "EKO" Then
txtHt.Text = "35000"
txtJk.Text = "EKONOMI"
txtJb.Text = "19.00"
ElseIf Kt = "MUT" Then
txtHt.Text = "23000"
txtJk.Text = "MUTIARA"
txtJb.Text = "17.00"
ElseIf Kt = "SEN" Then
txtHt.Text = "15000"
txtJk.Text = "SENJA"
txtJb.Text = "20.00"
End If
txtJt.SetFocus
End Sub

Private Sub txtJt_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTp.Text = Val(txtJt.Text) * Val(txtHt.Text)
End If
txtTerbilang.Text = terbilang(Val(txtTp.Text))
End Sub


Private Function baca(X As Integer) As String
Dim i As Long
Dim ratus(9) As String
Dim belas(9) As String
Dim puluh(9) As String
Dim satuan(9) As String
Dim sbaca As String
satuan(1) = "satu"
satuan(2) = "dua"
satuan(3) = "tiga"
satuan(4) = "empat"
satuan(5) = "lima"
satuan(6) = "enam"
satuan(7) = "tujuh"
satuan(8) = "delapan"
satuan(9) = "sembilan"
For i = 1 To 9
If i = 1 Then
puluh(i) = "sepuluh"
Else
puluh(i) = satuan(i) & " puluh"
End If
Next
For i = 1 To 9
If i = 1 Then
belas(i) = "sebelas"
Else
belas(i) = satuan(i) & " belas"
End If
Next
For i = 1 To 9
If i = 1 Then
ratus(i) = "seratus"
Else
ratus(i) = satuan(i) & " ratus"
End If
Next
If X >= 100 Then
sbaca = ratus(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 2))
End If
If X >= 20 Or X = 10 Then
sbaca = sbaca & " " & puluh(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 1))
Else
If X > 10 Then
sbaca = sbaca & " " & belas(Val(Mid(Str(X), 3, 1)))
X = -1
End If
End If
If X >= 1 Then
sbaca = sbaca & " " & satuan(Val((Str(X))))
End If
baca = sbaca
End Function
Function terbilang(X As Currency) As String
Dim ribu, juta, milyar, trilyun, ratusan As Integer
Dim sterbilang As String
Dim ptext As Byte
sterbilang = ""
If Val(X) = 1000000000000# Then
ptext = Len(Str(X)) - 13
trilyun = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(trilyun)) & " trilyun"
X = Val(Mid(Str(X), ptext + 2, 12))
End If
If X >= 1000000000 Then
ptext = Len(Str(X)) - 10
milyar = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(milyar)) & " milyar"
X = Val(Mid(Str(X), ptext + 2, 9))
End If
If X >= 1000000 Then
ptext = Len(Str(X)) - 7
juta = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(juta)) & " juta"
X = Val(Mid(Str(X), ptext + 2, 6))
End If
If X >= 1000 Then
ptext = Len(Str(X)) - 4
ribu = Val(Mid(Str(X), 2, ptext))
If ribu = 1 Then
sterbilang = "seribu"
Else
sterbilang = sterbilang & " " & baca(Val(ribu)) & " ribu"
End If
X = Val(Mid(Str(X), ptext + 2, 3))
End If
sterbilang = sterbilang & " " & baca(Val(X))
terbilang = Trim(sterbilang) & " rupiah"
End Function


Private Sub cmdBatal_Click()
'Kosongkan Semua
txtKb.Text = ""
txtNb.Text = ""
txtJs.Text = ""
txtSs.Text = ""
txtTj.Text = ""
txtHj.Text = ""
txtTh.Text = ""
txtTerbilang.Text=""
txtKb.SetFocus
End Sub

Private Sub cmdKeluar_Click()
End
End Sub

Private Sub cmdProses_Click()
Dim Kb As String
Kb = Right(txtKb.Text, 1)
If Kb = "T" Then
txtNb.Text = "Tape"
txtHj.Text = "275000"
ElseIf Kb = "S" Then
txtNb.Text = "Sound Sistem"
txtHj.Text = "350000"
ElseIf Kb = "C" Then
txtNb.Text = "Compact"
txtHj.Text = "480000"
End If
txtJs.SetFocus
End Sub

Private Sub txtJs_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtTj.SetFocus
End If
End Sub



Private Sub txtTj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtSs.Text = Val(txtJs.Text) - Val(txtTj.Text)
txtTh.Text = Val(txtTj.Text) * Val(txtHj.Text)
txtTerbilang.Text = terbilang(Val(txtTh.Text))
End If
End Sub


Private Function baca(X As Integer) As String
Dim i As Long
Dim ratus(9) As String
Dim belas(9) As String
Dim puluh(9) As String
Dim satuan(9) As String
Dim sbaca As String
satuan(1) = "satu"
satuan(2) = "dua"
satuan(3) = "tiga"
satuan(4) = "empat"
satuan(5) = "lima"
satuan(6) = "enam"
satuan(7) = "tujuh"
satuan(8) = "delapan"
satuan(9) = "sembilan"
For i = 1 To 9
If i = 1 Then
puluh(i) = "sepuluh"
Else
puluh(i) = satuan(i) & " puluh"
End If
Next
For i = 1 To 9
If i = 1 Then
belas(i) = "sebelas"
Else
belas(i) = satuan(i) & " belas"
End If
Next
For i = 1 To 9
If i = 1 Then
ratus(i) = "seratus"
Else
ratus(i) = satuan(i) & " ratus"
End If
Next
If X >= 100 Then
sbaca = ratus(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 2))
End If
If X >= 20 Or X = 10 Then
sbaca = sbaca & " " & puluh(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 1))
Else
If X > 10 Then
sbaca = sbaca & " " & belas(Val(Mid(Str(X), 3, 1)))
X = -1
End If
End If
If X >= 1 Then
sbaca = sbaca & " " & satuan(Val((Str(X))))
End If
baca = sbaca
End Function
Function terbilang(X As Currency) As String
Dim ribu, juta, milyar, trilyun, ratusan As Integer
Dim sterbilang As String
Dim ptext As Byte
sterbilang = ""
If Val(X) = 1000000000000# Then
ptext = Len(Str(X)) - 13
trilyun = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(trilyun)) & " trilyun"
X = Val(Mid(Str(X), ptext + 2, 12))
End If
If X >= 1000000000 Then
ptext = Len(Str(X)) - 10
milyar = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(milyar)) & " milyar"
X = Val(Mid(Str(X), ptext + 2, 9))
End If
If X >= 1000000 Then
ptext = Len(Str(X)) - 7
juta = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(juta)) & " juta"
X = Val(Mid(Str(X), ptext + 2, 6))
End If
If X >= 1000 Then
ptext = Len(Str(X)) - 4
ribu = Val(Mid(Str(X), 2, ptext))
If ribu = 1 Then
sterbilang = "seribu"
Else
sterbilang = sterbilang & " " & baca(Val(ribu)) & " ribu"
End If
X = Val(Mid(Str(X), ptext + 2, 3))
End If
sterbilang = sterbilang & " " & baca(Val(X))
terbilang = Trim(sterbilang) & " rupiah"
End Function



Private Sub cmdBt_Click()
txtMnk.SetFocus
txtMnk.Text = ""
txtMn.Text = ""
txtGl.Text = ""
txtKd.Text = ""
txtSt.Text = ""
txtTh.Text = ""
txtJb.Text = ""
txtBg.Text = ""
txtGp.Text = ""
txtTj.Text = ""
txtTg.Text = ""
txtTerbilang.Text = ""
End Sub

Private Sub cmdKl_Click()
End
End Sub

Private Sub cmdLg_Click()
txtMnk.SetFocus
txtMnk.Text = ""
txtMn.Text = ""
txtGl.Text = ""
txtKd.Text = ""
txtSt.Text = ""
txtTh.Text = ""
txtJb.Text = ""
txtBg.Text = ""
txtGp.Text = ""
txtTj.Text = ""
txtTg.Text = ""

End Sub

Private Sub cmdPrs_Click()
txtTh.Text = Mid(txtMn.Text, 5, 4)
Dim mn  As String
mn = Mid(txtMn.Text, 9, 1)
If mn = "A" Then
txtGl.Text = "A"
txtJb.Text = "Manager"
txtGp.Text = "3000000"
txtTj.Text = "875000"
ElseIf mn = "B" Then
txtGl.Text = "B"
txtJb.Text = "Ka Seksi"
txtGp.Text = "2500000"
txtTj.Text = "525000"
ElseIf mn = "C" Then
txtGl.Text = "C"
txtJb.Text = "Staff"
txtGp.Text = "2000000"
txtTj.Text = "325000"
End If
mn = Right(txtMn, 1)
If mn = "M" Then
txtKd.Text = "M"
txtSt.Text = "Menikah"
ElseIf mn = "S" Then
txtKd.Text = "S"
txtSt.Text = "Single"
ElseIf mn = "D" Then
txtKd.Text = "D"
txtSt.Text = "Duda"
ElseIf mn = "J" Then
txtKd.Text = "J"
txtSt.Text = "Janda"
End If
mn = Left(txtMn.Text, 3)
If mn = "SDM" Then
txtBg.Text = "General Affair"
ElseIf mn = "KEU" Then
txtBg.Text = "Accounting"
ElseIf mn = "ADM" Then
txtBg.Text = "Administrasi"
ElseIf mn = "SPM" Then
txtBg.Text = "Security"
ElseIf mn = "EDP" Then
txtBg.Text = "IT Unit"
End If
txtTg.Text = Val(txtGp) + (txtTj)
txtTerbilang.Text = terbilang(Val(txtTg.Text))
End Sub

Private Sub txtMnk_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtMn.SetFocus
End If
End Sub


Private Function baca(X As Integer) As String
Dim i As Long
Dim ratus(9) As String
Dim belas(9) As String
Dim puluh(9) As String
Dim satuan(9) As String
Dim sbaca As String
satuan(1) = "satu"
satuan(2) = "dua"
satuan(3) = "tiga"
satuan(4) = "empat"
satuan(5) = "lima"
satuan(6) = "enam"
satuan(7) = "tujuh"
satuan(8) = "delapan"
satuan(9) = "sembilan"
For i = 1 To 9
If i = 1 Then
puluh(i) = "sepuluh"
Else
puluh(i) = satuan(i) & " puluh"
End If
Next
For i = 1 To 9
If i = 1 Then
belas(i) = "sebelas"
Else
belas(i) = satuan(i) & " belas"
End If
Next
For i = 1 To 9
If i = 1 Then
ratus(i) = "seratus"
Else
ratus(i) = satuan(i) & " ratus"
End If
Next
If X >= 100 Then
sbaca = ratus(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 2))
End If
If X >= 20 Or X = 10 Then
sbaca = sbaca & " " & puluh(Val(Mid(Str(X), 2, 1)))
X = Val(Mid(Str(X), 3, 1))
Else
If X > 10 Then
sbaca = sbaca & " " & belas(Val(Mid(Str(X), 3, 1)))
X = -1
End If
End If
If X >= 1 Then
sbaca = sbaca & " " & satuan(Val((Str(X))))
End If
baca = sbaca
End Function
Function terbilang(X As Currency) As String
Dim ribu, juta, milyar, trilyun, ratusan As Integer
Dim sterbilang As String
Dim ptext As Byte
sterbilang = ""
If Val(X) = 1000000000000# Then
ptext = Len(Str(X)) - 13
trilyun = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(trilyun)) & " trilyun"
X = Val(Mid(Str(X), ptext + 2, 12))
End If
If X >= 1000000000 Then
ptext = Len(Str(X)) - 10
milyar = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(milyar)) & " milyar"
X = Val(Mid(Str(X), ptext + 2, 9))
End If
If X >= 1000000 Then
ptext = Len(Str(X)) - 7
juta = Val(Mid(Str(X), 2, ptext))
sterbilang = sterbilang & " " & baca(Val(juta)) & " juta"
X = Val(Mid(Str(X), ptext + 2, 6))
End If
If X >= 1000 Then
ptext = Len(Str(X)) - 4
ribu = Val(Mid(Str(X), 2, ptext))
If ribu = 1 Then
sterbilang = "seribu"
Else
sterbilang = sterbilang & " " & baca(Val(ribu)) & " ribu"
End If
X = Val(Mid(Str(X), ptext + 2, 3))
End If
sterbilang = sterbilang & " " & baca(Val(X))
terbilang = Trim(sterbilang) & " rupiah"
End Function


Private Sub Cmd_oke_Click()
'oke edit by benk2
Label_hrf.Caption = Text_tna.Text
End Sub

Private Sub Cmd_sls_Click()
End
End Sub

Private Sub Option_bru_Click()
Label_hrf.ForeColor = vbBlue
End Sub

Private Sub Option_mrh_Click()
Label_hrf.ForeColor = vbRed
End Sub

Private Sub Check_tbl_Click()
Label_hrf.FontBold = Check_tbl.Value
End Sub

Private Sub Check_mrg_Click()
Label_hrf.FontItalic = Check_mrg.Value
End Sub

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s