kode vb kb
Dim informasi As Byte
Private Sub Bersih()
‘ Txtnoseri.Text = “”
Txtnama.Text = “”
Txtalamat.Text = “”
Txtumur.Text = “”
txtjmlanak.Text = “”
cmbkb.Text = “”
cmbulang.Text = “”
cmbmetode.Text = “”
txtjenis.Text = “”
txtgagal.Text = “”
txtcabut.Text = “”
txtket.Text = “”
Text1.Text = “”
Text2.Text = “”
Text3.Text = “”
Text4.Text = “”
Text5.Text = “”
Text6.Text = “”
Text7.Text = “”
End Sub
Private Sub Tutup()
Txtnama.Enabled = False
Txtalamat.Enabled = False
Txtumur.Enabled = False
txtjmlanak.Enabled = False
cmbkb.Enabled = False
cmbulang.Enabled = False
cmbmetode.Enabled = False
txtjenis.Enabled = False
txtgagal.Enabled = False
txtcabut.Enabled = False
txtket.Enabled = False
End Sub
Private Sub Buka()
Txtnama.Enabled = True
Txtalamat.Enabled = True
Txtumur.Enabled = True
txtjmlanak.Enabled = True
cmbkb.Enabled = True
cmbulang.Enabled = True
cmbmetode.Enabled = True
txtjenis.Enabled = True
txtgagal.Enabled = True
txtcabut.Enabled = True
txtket.Enabled = True
End Sub
Private Sub cmbkb_Click()
If cmbkb = “Pil” Then
Text1 = “1”
End If
If cmbkb = “Suntik” Then
Text2 = “1”
End If
If cmbkb = “MOP” Then
Text3 = “1”
End If
If cmbkb = “MOW” Then
Text4 = “1”
End If
If cmbkb = “Kondom” Then
Text5 = “1”
End If
If cmbkb = “Implant” Then
Text6 = “1”
End If
If cmbkb = “IUD” Then
Text7 = “1”
End If
End Sub
Private Sub cmbmetode_Click()
If cmbmetode = “Ekspulsi Kapsul” Then
txtjenis = “IP3/IP5”
ElseIf cmbmetode = “Migrasi Kapsul” Then
txtjenis = “IP3/IP5”
ElseIf cmbmetode = “Pembengkakan” Then
txtjenis = “IP3/IP5,S”
ElseIf cmbmetode = “Infeksi” Then
txtjenis = “IP3/IP5,S dan MO”
ElseIf cmbmetode = “Hematoma” Then
txtjenis = “IP5/IP3,S dan MO”
Else
txtjenis = “IUD”
End If
End Sub
Private Sub cmbulang_Click()
If cmbulang = “Pil” Then
Text1 = “1”
End If
If cmbulang = “Suntik” Then
Text2 = “1”
End If
If cmbulang = “MOP” Then
Text3 = “1”
End If
If cmbulang = “MOW” Then
Text4 = “1”
End If
If cmbulang = “Kondom” Then
Text5 = “1”
End If
If cmbulang = “Implant” Then
Text6 = “1”
End If
If cmbulang = “IUD” Then
Text7 = “1”
End If
End Sub
Private Sub cmdcancel_Click()
Bersih
Txtnoseri.SetFocus
Tutup
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
End Sub
Private Sub cmdclose_Click()
frmKB.Hide
Menu.Show
End Sub
Private Sub cmddelete_Click()
informasi = MsgBox(“Data KB ” + Txtnama.Text + “DiDelete”, 4 + 48, “Delete”)
If informasi = 6 Then
On Error Resume Next
Data1.Recordset.Delete
Form_Activate
Exit Sub
Else
Form_Activate
End If
End Sub
Private Sub cmdedit_Click()
informasi = MsgBox(“Data KB ” + Txtnama.Text + “Di Edit”, 4 + 48, “Edit”)
If informasi = 6 Then
Data1.Recordset.Edit
Data1.Recordset!No_Seri = Txtnoseri.Text
Data1.Recordset!nama = Txtnama.Text
Data1.Recordset!alamat = Txtalamat.Text
Data1.Recordset!umur = Txtumur.Text
Data1.Recordset!jml_anak = txtjmlanak.Text
Data1.Recordset!tgl = DTPicker1.Value
Data1.Recordset!Kb_Baru = cmbkb.Text
Data1.Recordset!Kb_Lama = cmbulang.Text
Data1.Recordset!metode = cmbmetode.Text
Data1.Recordset!jenis = txtjenis.Text
Data1.Recordset!Gagal = txtgagal.Text
Data1.Recordset!cabut = txtcabut.Text
Data1.Recordset!Ket = txtket.Text
Data1.Recordset.Update
Form_Activate
Exit Sub
Else
Form_Activate
End If
End Sub
Private Sub cmdsave_Click()
informasi = MsgBox(“Data Akan Disimpan”, vbOKCancel + 64, “Informasi”)
If informasi = vbOK Then
‘On Error Resume Next
Data1.Recordset.AddNew
Data1.Recordset!No_Seri = Txtnoseri.Text
Data1.Recordset!nama = Txtnama.Text
Data1.Recordset!alamat = Txtalamat.Text
Data1.Recordset!umur = Txtumur.Text
Data1.Recordset!jml_anak = txtjmlanak.Text
Data1.Recordset!tgl = DTPicker1.Value
Data1.Recordset!Kb_Baru = cmbkb.Text
Data1.Recordset!Kb_Lama = cmbulang.Text
Data1.Recordset!metode = cmbmetode.Text
Data1.Recordset!jenis = txtjenis.Text
Data1.Recordset!Gagal = txtgagal.Text
Data1.Recordset!cabut = txtcabut.Text
Data1.Recordset!Ket = txtket.Text
Data1.Recordset.Update
cmdsave.Enabled = False
With Data2.Recordset
.Index = “Jumlah”
.Seek “=”, Txtalamat.Text, Bln, Th
If Not .NoMatch Then
.Edit
If cmbkb = “Pil” Then
!pil = !pil + 1
End If
If cmbkb = “Suntik” Then
!suntik = !suntik + 1
End If
If cmbkb = “MOP” Then
!mop = !mop + 1
End If
If cmbkb = “MOW” Then
!mow = !mow + 1
End If
If cmbkb = “Kondom” Then
!kondom = !kondom + 1
End If
If cmbkb = “Implant” Then
!implant = !implant + 1
End If
If cmbkb = “IUD” Then
!iud = !iud + 1
End If
!total = !total + 1
!Bln = Bln
!Th = Th
.Update
Else
.AddNew
!alamat = Txtalamat
!pil = Val(Text1)
!suntik = Val(Text2)
!mop = Val(Text3)
!mow = Val(Text4)
!kondom = Val(Text5)
!implant = Val(Text6)
!iud = Val(Text7)
!total = 1
!Bln = Bln
!Th = Th
.Update
End If
End With
Else
Txtnoseri.SetFocus
End If
Bersih
Txtnoseri.Text = “”
Txtnoseri.SetFocus
Form_Activate
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
End Sub
Private Sub DTPicker1_Change()
Bln = Month(DTPicker1)
Th = Year(DTPicker1)
End Sub
Private Sub Form_Activate()
Bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
Bln = Month(DTPicker1)
Th = Year(DTPicker1)
‘cmdcancel_Click
End Sub
Private Sub Form_Load()
Data1.DatabaseName = App.Path & “\KB.mdb”
Data2.DatabaseName = App.Path & “\KB.mdb”
End Sub
Private Sub txtcabut_Change()
If KeyAscii = 13 Then
txtcabut.SetFocus
End If
End Sub
Private Sub txtcabut_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtket.SetFocus
End If
End Sub
Private Sub txtgagal_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtcabut.SetFocus
End If
End Sub
Private Sub txtnama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Txtalamat.SetFocus
End If
End Sub
Private Sub txtalamat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Txtumur.SetFocus
End If
End Sub
Private Sub txtumur_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
txtjmlanak.SetFocus
End If
If Not (KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
Pesan = MsgBox("MAAF…DATA DI ISI DENGAN ANGKA..!", vbExclamation + vbOKOnly, "PERINGATAN!!")
End If
End Sub
Private Sub txtjmlanak_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
cmbkb.SetFocus
End If
If Not (KeyAscii 6 Then
Exit Sub
End If
With Data1.Recordset
.FindFirst “No_Seri='” + Txtnoseri.Text + “‘”
If Not .NoMatch Then
Tampil
Tutup
cmbulang.Enabled = True
cmbmetode.Enabled = True
txtjenis.Enabled = True
txtgagal.Enabled = True
txtcabut.Enabled = True
txtket.Enabled = True
cmbulang.Enabled = True
cmddelete.Enabled = True
cmdedit.Enabled = True
Else
Buka
cmbulang.Enabled = False
Bersih
cmdsave.Enabled = True
End If
End With
cmdcancel.Enabled = True
End Sub
Private Sub txtnoseri_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
Txtnama.SetFocus
End If
If Not (KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
Pesan = MsgBox("MAAF…DATA DI ISI DENGAN ANGKA..!", vbExclamation + vbOKOnly, "PERINGATAN!!")
End If
End Sub
koode laporan 1
Private Sub CmCetak_Click()
Data1.Refresh
Dim Grs As String
Data1.Recordset.MoveFirst
Printer.CurrentX = 0
Printer.CurrentY = 0
nom = 0
Do While Not Data1.Recordset.EOF
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Tab(22); "LAPORAN DATA PESERTA KELUARGA BERENCANA (KB)"
Printer.Print Tab(35); "PUSKESMAS TANGGAMUS"
Printer.FontSize = 7
Printer.FontBold = False
Printer.Print
Grs = String$(317, "-")
Printer.Print Tab(5); Grs
Printer.Print Tab(5); "No.";
Printer.Print Tab(10); "No_Seri Kartu";
Printer.Print Tab(25); "Nama Peserta";
Printer.Print Tab(47); "Alamat";
Printer.Print Tab(75); "Umur";
Printer.Print Tab(80); "Jml_Anak";
Printer.Print Tab(90); "Pelayanan KB";
Printer.Print Tab(105); "Pelayanan Ulang";
Printer.Print Tab(125); "Metode";
Printer.Print Tab(145); "Jenis";
Printer.Print Tab(160); "Kegagalan";
Printer.Print Tab(175); "Keterangan";
Printer.Print Tab(5); Grs
Brs = 0
Do While Not Data1.Recordset.EOF And Brs <= 44
nom = nom + 1
On Error Resume Next
Printer.Print Tab(5); nom;
Printer.Print Tab(10); Data1.Recordset!No_Seri;
Printer.Print Tab(25); Data1.Recordset!nama;
Printer.Print Tab(47); Data1.Recordset!alamat;
Printer.Print Tab(75); Data1.Recordset!umur;
Printer.Print Tab(80); Data1.Recordset!jml_anak;
Printer.Print Tab(90); Data1.Recordset!Kb_Baru;
Printer.Print Tab(105); Data1.Recordset!Kb_Lama;
Printer.Print Tab(125); Data1.Recordset!metode;
Printer.Print Tab(147); Data1.Recordset!jenis;
Printer.Print Tab(160); Data1.Recordset!Gagal;
Printer.Print Tab(175); Data1.Recordset!Ket;
Brs = Brs + 1
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
Printer.Print Tab(5); Grs
Printer.Print
Printer.Print Tab(145); "Tanggamus, "; Format(Date, "dd-mm-yyyy")
Printer.Print Tab(150); "Mengetahui"
Printer.Print
Printer.Print
Printer.Print
Printer.Print Tab(145); " (…………………………. )"
Printer.NewPage
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
Printer.EndDoc
End Sub
Private Sub CmdKel_Click()
Lp1.Hide
Menu.Show
End Sub
Private Sub Combo1_Click()
CmCetak.Enabled = False
Command1.Enabled = False
Data1.RecordSource = " Select * from peserta_KB where month(tgl) = '" + Combo1.Text + "' and year(tgl)='" + Combo2.Text + "'"
Data1.Refresh
Do While Not Data1.Recordset.EOF
CmCetak.Enabled = True
Command1.Enabled = True
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Combo2_Click()
CmCetak.Enabled = False
Command1.Enabled = False
Data1.RecordSource = " Select * from peserta_KB where month(tgl) = '" + Combo1.Text + "' and year(tgl)='" + Combo2.Text + "'"
Data1.Refresh
Do While Not Data1.Recordset.EOF
CmCetak.Enabled = True
Command1.Enabled = True
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Command1_Click()
Data1.RecordSource = " Select * from peserta_KB"
Data1.Refresh
Dim Grs As String
Data1.Recordset.MoveFirst
F.Show
nom = 0
Do While Not Data1.Recordset.EOF
F.Print
F.FontSize = 10
F.FontBold = True
F.Print Tab(22); "LAPORAN DATA PESERTA KELUARGA BERENCANA (KB)"
F.Print Tab(35); "PUSKESMAS TANGGAMUS"
F.FontSize = 7
F.FontBold = False
F.Print
Grs = String$(317, "-")
F.Print Tab(5); Grs
F.Print Tab(5); "No.";
F.Print Tab(10); "No_Seri Kartu";
F.Print Tab(25); "Nama Peserta";
F.Print Tab(47); "Alamat";
F.Print Tab(75); "umur";
F.Print Tab(80); "jml_anak";
F.Print Tab(90); "Pelayanan KB";
F.Print Tab(105); "Pelayanan Ulang";
F.Print Tab(125); "Metode";
F.Print Tab(145); "Jenis";
F.Print Tab(160); "Kegagalan";
F.Print Tab(175); "Keterangan";
F.Print Tab(5); Grs
Brs = 0
Do While Not Data1.Recordset.EOF And Brs <= 44
nom = nom + 1
On Error Resume Next
F.Print Tab(5); nom;
F.Print Tab(10); Data1.Recordset!No_Seri;
F.Print Tab(25); Data1.Recordset!nama;
F.Print Tab(47); Data1.Recordset!alamat;
F.Print Tab(75); Data1.Recordset!umur;
F.Print Tab(80); Data1.Recordset!jml_anak;
F.Print Tab(90); Data1.Recordset!Kb_Baru;
F.Print Tab(105); Data1.Recordset!Kb_Lama;
F.Print Tab(125); Data1.Recordset!metode;
F.Print Tab(145); Data1.Recordset!jenis;
F.Print Tab(160); Data1.Recordset!Gagal;
F.Print Tab(175); Data1.Recordset!Ket;
Brs = Brs + 1
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
F.Print Tab(5); Grs
F.Print
F.Print Tab(145); "Tanggamus, "; Format(Date, "dd-mm-yyyy")
F.Print Tab(150); "Mengetahui"
F.Print
F.Print
F.Print
F.Print Tab(145); " (…………………………. )"
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Form_Activate()
CmCetak.Enabled = False
Command1.Enabled = False
Combo2 = Format(Date, "yyyy")
End Sub
Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\KB.mdb"
End Sub
kode vb laporan2
Private Sub CmCetak_Click()
Data1.Refresh
Dim Grs As String
Data1.Recordset.MoveFirst
Printer.CurrentX = 0
Printer.CurrentY = 0
nom = 0
Do While Not Data1.Recordset.EOF
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Tab(22); "LAPORAN DATA PESERTA KELUARGA BERENCANA (KB)"
Printer.Print Tab(35); "PUSKESMAS TANGGAMUS"
Printer.FontSize = 7
Printer.FontBold = False
Printer.Print
Grs = String$(317, "-")
Printer.Print Tab(5); Grs
Printer.Print Tab(5); "No.";
Printer.Print Tab(10); "No_Seri Kartu";
Printer.Print Tab(25); "Nama Peserta";
Printer.Print Tab(47); "Alamat";
Printer.Print Tab(75); "Umur";
Printer.Print Tab(80); "Jml_Anak";
Printer.Print Tab(90); "Pelayanan KB";
Printer.Print Tab(105); "Pelayanan Ulang";
Printer.Print Tab(125); "Metode";
Printer.Print Tab(145); "Jenis";
Printer.Print Tab(160); "Kegagalan";
Printer.Print Tab(175); "Keterangan";
Printer.Print Tab(5); Grs
Brs = 0
Do While Not Data1.Recordset.EOF And Brs <= 44
nom = nom + 1
On Error Resume Next
Printer.Print Tab(5); nom;
Printer.Print Tab(10); Data1.Recordset!No_Seri;
Printer.Print Tab(25); Data1.Recordset!nama;
Printer.Print Tab(47); Data1.Recordset!alamat;
Printer.Print Tab(75); Data1.Recordset!umur;
Printer.Print Tab(80); Data1.Recordset!jml_anak;
Printer.Print Tab(90); Data1.Recordset!Kb_Baru;
Printer.Print Tab(105); Data1.Recordset!Kb_Lama;
Printer.Print Tab(125); Data1.Recordset!metode;
Printer.Print Tab(147); Data1.Recordset!jenis;
Printer.Print Tab(160); Data1.Recordset!Gagal;
Printer.Print Tab(175); Data1.Recordset!Ket;
Brs = Brs + 1
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
Printer.Print Tab(5); Grs
Printer.Print
Printer.Print Tab(145); "Tanggamus, "; Format(Date, "dd-mm-yyyy")
Printer.Print Tab(150); "Mengetahui"
Printer.Print
Printer.Print
Printer.Print
Printer.Print Tab(145); " (…………………………. )"
Printer.NewPage
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
Printer.EndDoc
End Sub
Private Sub CmdKel_Click()
Lp1.Hide
Menu.Show
End Sub
Private Sub Combo1_Click()
CmCetak.Enabled = False
Command1.Enabled = False
Data1.RecordSource = " Select * from peserta_KB where month(tgl) = '" + Combo1.Text + "' and year(tgl)='" + Combo2.Text + "'"
Data1.Refresh
Do While Not Data1.Recordset.EOF
CmCetak.Enabled = True
Command1.Enabled = True
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Combo2_Click()
CmCetak.Enabled = False
Command1.Enabled = False
Data1.RecordSource = " Select * from peserta_KB where month(tgl) = '" + Combo1.Text + "' and year(tgl)='" + Combo2.Text + "'"
Data1.Refresh
Do While Not Data1.Recordset.EOF
CmCetak.Enabled = True
Command1.Enabled = True
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Command1_Click()
Data1.RecordSource = " Select * from peserta_KB"
Data1.Refresh
Dim Grs As String
Data1.Recordset.MoveFirst
F.Show
nom = 0
Do While Not Data1.Recordset.EOF
F.Print
F.FontSize = 10
F.FontBold = True
F.Print Tab(22); "LAPORAN DATA PESERTA KELUARGA BERENCANA (KB)"
F.Print Tab(35); "PUSKESMAS TANGGAMUS"
F.FontSize = 7
F.FontBold = False
F.Print
Grs = String$(317, "-")
F.Print Tab(5); Grs
F.Print Tab(5); "No.";
F.Print Tab(10); "No_Seri Kartu";
F.Print Tab(25); "Nama Peserta";
F.Print Tab(47); "Alamat";
F.Print Tab(75); "umur";
F.Print Tab(80); "jml_anak";
F.Print Tab(90); "Pelayanan KB";
F.Print Tab(105); "Pelayanan Ulang";
F.Print Tab(125); "Metode";
F.Print Tab(145); "Jenis";
F.Print Tab(160); "Kegagalan";
F.Print Tab(175); "Keterangan";
F.Print Tab(5); Grs
Brs = 0
Do While Not Data1.Recordset.EOF And Brs <= 44
nom = nom + 1
On Error Resume Next
F.Print Tab(5); nom;
F.Print Tab(10); Data1.Recordset!No_Seri;
F.Print Tab(25); Data1.Recordset!nama;
F.Print Tab(47); Data1.Recordset!alamat;
F.Print Tab(75); Data1.Recordset!umur;
F.Print Tab(80); Data1.Recordset!jml_anak;
F.Print Tab(90); Data1.Recordset!Kb_Baru;
F.Print Tab(105); Data1.Recordset!Kb_Lama;
F.Print Tab(125); Data1.Recordset!metode;
F.Print Tab(145); Data1.Recordset!jenis;
F.Print Tab(160); Data1.Recordset!Gagal;
F.Print Tab(175); Data1.Recordset!Ket;
Brs = Brs + 1
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
F.Print Tab(5); Grs
F.Print
F.Print Tab(145); "Tanggamus, "; Format(Date, "dd-mm-yyyy")
F.Print Tab(150); "Mengetahui"
F.Print
F.Print
F.Print
F.Print Tab(145); " (…………………………. )"
If Data1.Recordset.EOF Then
Exit Do
End If
Loop
End Sub
Private Sub Form_Activate()
CmCetak.Enabled = False
Command1.Enabled = False
Combo2 = Format(Date, "yyyy")
End Sub
Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\KB.mdb"
End Sub