Listing Program
Program Menu Utama
Private Sub MDIForm_Load()
BukaDb
Set rsUtama = New [Link]
[Link] = adUseClient
[Link] "Select * From T_Transaksi", DbCon, adOpenDynamic,
adLockOptimistic
End Sub
Private Sub mnuCetakLaporan_Click()
[Link]
End Sub
Private Sub mnuDataFakultas_Click()
[Link]
End Sub
Private Sub mnuDataTransaksi_Click()
[Link]
End Sub
Private Sub mnuInfo_Click()
[Link]
End Sub
Private Sub mnuPenerimaan_Click()
[Link]
End Sub
Private Sub mnuPengeluaran_Click()
[Link]
End Sub
Program Form Data Transaksi
Option Explicit
Private Sub AturTampilanTombolPerintah()
Dim boLocked As Boolean, I As Byte
If sProses = "LIHAT" Then
1
[Link] = "&Input"
[Link] = "&Ubah"
[Link] = True
[Link] = True
boLocked = True
Else
[Link] = "&Simpan"
[Link] = "&Batal"
[Link] = True
[Link] = False
[Link] = False
boLocked = False
End If
'Atur properti Locked data isian
For I = 0 To [Link]
txtIsian(I).Locked = boLocked
Next
End Sub
Private Function fuboKetemu() As Boolean
Dim sTeks As String
fuboKetemu = False
sTeks = Trim([Link])
If sTeks <> "" Then
With rsTransaksi
If nJumRec > 0 Then
.MoveFirst
.Find "KodeTransaksi='" & sTeks & "'"
If Not .EOF Then fuboKetemu = True
End If
End With
End If
End Function
Private Function fuboValidasiKosong(ByVal sField As String) As Boolean
Dim sPesan As String
sPesan = ""
If sField = "SEMUA" Or sField = "KodeTransaksi" Then
If Trim([Link]) = "" Then
sPesan = "KodeTransaksi"
[Link]
End If
End If
If sPesan = "" And (sField = "SEMUA" Or sField = "NAMA") Then
If Trim(txtIsian(0).Text) = "" Then
sPesan = "Nama Transaksi"
txtIsian(0).SetFocus
2
End If
End If
If sPesan <> "" Then
MsgBox "Data '" & sPesan & "' harus diisi!", vbExclamation, "Peringatan..."
fuboValidasiKosong = False
Else
fuboValidasiKosong = True
End If
End Function
Private Sub KosongkanTampilan()
Dim I As Byte
If sProses = "INPUT" Then
[Link] = ""
[Link]
Else 'Proses LIHAT
[Link] = False
[Link] = False
End If
For I = 0 To [Link]
txtIsian(I).Text = ""
Next
End Sub
Private Sub SimpanRecord()
With rsTransaksi
If sProses = "INPUT" Then
.AddNew
nJumRec = nJumRec + 1
End If
sKunciRec = Trim([Link])
!KodeTransaksi = sKunciRec
!NamaTransaksi = Trim(txtIsian(0).Text)
!NamaInduk = Trim(txtIsian(1).Text)
.Update
End With
End Sub
Private Sub TampilkanRecord()
With rsTransaksi
sKunciRec = !KodeTransaksi
[Link] = sKunciRec
txtIsian(0).Text = !NamaTransaksi
txtIsian(1).Text = !NamaInduk
End With
End Sub
3
Private Sub cmdHapus_Click()
If MsgBox("Hapus data Transaksi ini?", vbQuestion + vbYesNo, "Konfirmasi...") =
vbYes Then
sProses = "HAPUS"
With rsTransaksi
.Delete
[Link]
nJumRec = nJumRec - 1
If nJumRec = 0 Then
cmdInputSimpan_Click
Else
.MoveNext
If .EOF Then .MoveLast
sProses = "LIHAT"
TampilkanRecord
End If
End With
End If
End Sub
Private Sub cmdInputSimpan_Click()
If [Link] = "&Input" Then
sProses = "INPUT"
[Link] = "Input Data Transaksi"
AturTampilanTombolPerintah
KosongkanTampilan
Else 'Simpan record
If sProses = "INPUT" Then
If fuboKetemu Then
MsgBox "Kode Transaksi ini sudah ada!", vbInformation, "Informasi..."
[Link]
Exit Sub
End If
End If
If fuboValidasiKosong("SEMUA") Then
SimpanRecord
If sProses = "INPUT" Then
KosongkanTampilan
Else 'sProses = "UBAH"
TampilkanRecord
sProses = "LIHAT"
AturTampilanTombolPerintah
[Link] = True
[Link]
End If
End If
4
End If
End Sub
Private Sub cmdSelesai_Click()
Unload Me
End Sub
Private Sub cmdUbahBatal_Click()
If [Link] = "&Ubah" Then
sProses = "UBAH"
[Link] = "Ubah Data Transaksi"
AturTampilanTombolPerintah
[Link] = False
txtIsian(0).SetFocus
Else 'Batal
If sProses = "INPUT" Then
If nJumRec = 0 Then
Unload Me
Exit Sub
Else
With rsTransaksi
.MoveFirst
.Find "KodeTransaksi='" & sKunciRec & "'"
End With
End If
Else 'Batal Ubah
[Link] = True
End If
TampilkanRecord
sProses = "LIHAT"
[Link] = "Lihat Data Transaksi"
AturTampilanTombolPerintah
[Link]
End If
End Sub
Private Sub dtcKodeTransaksi_Change()
If sProses <> "LIHAT" Then Exit Sub
If fuboKetemu Then
TampilkanRecord
If [Link] = False Then
[Link] = True
[Link] = True
End If
Else
5
KosongkanTampilan
End If
End Sub
Private Sub Form_Activate()
With rsTransaksi
nJumRec = .RecordCount
If nJumRec = 0 Then
cmdInputSimpan_Click
Else
[Link] = "Lihat Data Transaksi"
sProses = "LIHAT"
AturTampilanTombolPerintah
.MoveLast
TampilkanRecord
End If
End With
End Sub
Private Sub Form_Load()
BukaDb
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Transaksi ORDER BY KodeTransaksi",
DbCon, adOpenDynamic, adLockOptimistic
Set [Link] = rsTransaksi
[Link] = "KodeTransaksi"
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Program Form Penerimaan
Private Sub cmdCari_Click()
Pemanggil = "crTransaksi"
[Link]
End Sub
Private Sub cmdCari2_Click()
Pemanggil = "crFakultas"
[Link]
6
End Sub
Private Sub cmdHapus_Click()
[Link] ("Delete From Penerimaan Where Tanggal=#" & [Link] &
"# and KodeTransaksi='" & txtKodeTransaksi & "'")
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = True
[Link] = False
End Sub
Private Sub cmdSimpan_Click()
If [Link] = "" Then
MsgBox "Isi Tanggal Penerimaan ! ", vbExclamation
ElseIf Validate = False Then
[Link] ("insert into Penerimaan values ('" & [Link] & "','"
& Format([Link], "mm/dd/yyyy") & "','" & [Link] & "','" &
[Link] & "' )")
[Link] = False
[Link] = True
[Link] = True
Else
MsgBox "Data sudah ada", vbCritical, "Peringatan...!"
cmdTambah_Click
Exit Sub
End If
End Sub
Private Sub cmdTambah_Click()
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = ""
7
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = False
[Link] = False
[Link]
[Link] = False
[Link]
End Sub
Private Sub cmdUbahBatal_Click()
[Link]
Unload Me
End Sub
Private Sub cmdUbah_Click()
Unload Me
[Link]
End Sub
Private Sub cmdUpdate_Click()
[Link] ("Update Penerimaan Set KodeFakultas='" & [Link]
& "',Jumlah=" & [Link] & " Where Tanggal=#" & [Link] & "# and
KodeTransaksi='" & txtKodeTransaksi & "'")
[Link] = False
[Link] = True
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
BukaDb
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Transaksi ORDER BY KodeTransaksi",
DbCon, adOpenDynamic, adLockOptimistic
8
Set rsFakultas = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas ORDER BY KodeFakultas",
DbCon, adOpenDynamic, adLockOptimistic
[Link] = False
[Link] = False
[Link] = False
End Sub
Private Sub txtKodeFakultas_Change()
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
[Link] = !NamaFakultas
End With
End Sub
Private Sub txtKodeTransaksi_Change()
On Error Resume Next
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Transaksi where KodeTransaksi='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsTransaksi
[Link] = !NamaTransaksi
End With
End Sub
Private Function Validate() As Boolean
Set rsPenerimaan = New [Link]
[Link] = adUseClient
[Link] "Select * From Penerimaan Where Tanggal=#" &
[Link] & "# And KodeTransaksi='" & [Link] & "' and
KodeFakultas='" & [Link] & "'", DbCon, adOpenDynamic,
adLockOptimistic
If [Link] Then
Validate = False
Else
Validate = True
End If
End Function
9
Program Form Pengeluaran
Private Sub cmdCari_Click()
Pemanggil2 = "crTransaksi"
[Link]
End Sub
Private Sub cmdCari2_Click()
Pemanggil2 = "crFakultas"
[Link]
End Sub
Private Sub cmdHapus_Click()
[Link] ("Delete From Pengeluaran Where Tanggal=#" & [Link] &
"# and KodeTransaksi='" & txtKodeTransaksi & "'")
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = True
[Link] = False
End Sub
Private Sub cmdSimpan_Click()
If [Link] = "" Then
MsgBox "Isi Tanggal Pengeluaran ! ", vbExclamation
ElseIf Validate = False Then
[Link] ("insert into Pengeluaran values ('" & [Link] & "','"
& Format([Link], "mm/dd/yyyy") & "','" & [Link] & "','" &
[Link] & "' )")
[Link] = False
[Link] = True
[Link] = True
Else
MsgBox "Data sudah ada", vbCritical, "Peringatan...!"
cmdTambah_Click
Exit Sub
End If
End Sub
10
Private Sub cmdTambah_Click()
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = False
[Link] = False
[Link]
[Link] = False
[Link]
End Sub
Private Sub cmdUbahBatal_Click()
[Link]
Unload Me
End Sub
Private Sub cmdUbah_Click()
Unload Me
[Link]
End Sub
Private Sub cmdUpdate_Click()
[Link] ("Update Pengeluaran Set KodeFakultas='" & [Link]
& "',Jumlah=" & [Link] & " Where Tanggal=#" & [Link] & "# and
KodeTransaksi='" & txtKodeTransaksi & "'")
[Link] = False
[Link] = True
End Sub
Private Sub Command1_Click()
Unload Me
11
End Sub
Private Sub Form_Load()
BukaDb
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Transaksi ORDER BY KodeTransaksi",
DbCon, adOpenDynamic, adLockOptimistic
Set rsFakultas = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas ORDER BY KodeFakultas",
DbCon, adOpenDynamic, adLockOptimistic
[Link] = False
[Link] = False
[Link] = False
End Sub
Private Sub txtKodeFakultas_Change()
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
[Link] = !NamaFakultas
End With
End Sub
Private Sub txtKodeTransaksi_Change()
On Error Resume Next
Set rsTransaksi = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Transaksi where KodeTransaksi='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsTransaksi
[Link] = !NamaTransaksi
End With
End Sub
Private Function Validate() As Boolean
Set rsPengeluaran = New [Link]
[Link] = adUseClient
[Link] "Select * From Pengeluaran Where Tanggal=#" &
[Link] & "# And KodeTransaksi='" & [Link] & "' and
12
KodeFakultas='" & [Link] & "'", DbCon, adOpenDynamic,
adLockOptimistic
If [Link] Then
Validate = False
Else
Validate = True
End If
End Function
Program Form Pencarian Penerimaan
Private Sub cmdEdit_Click()
If VarType(rsPenerimaan(0)) = vbObject Then
MsgBox "Tentukan Data Penerimaan yang akan diedit!", vbExclamation
Else
Set frmPenerimaan = New frmPenerimaan
[Link]
[Link] = rsPenerimaan(1)
[Link] = rsPenerimaan(2)
[Link] = rsPenerimaan(0)
[Link] = rsPenerimaan(3)
[Link] = True
[Link] = True
[Link] = False
[Link] = False
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
End If
Unload Me
End Sub
Private Sub cmdKeluar_Click()
Unload Me
[Link]
End Sub
Private Sub dtcKode_Change()
Set rsFakultas = New [Link]
13
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
[Link] = !NamaFakultas
Set rsPenerimaan = New [Link]
[Link] = adUseClient
[Link] "Select * From Penerimaan Where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
Set [Link] = rsPenerimaan
End With
End Sub
Private Sub Form_Load()
BukaDb
Set rsFakultas = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas ORDER BY KodeFakultas",
DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
Set [Link] = rsFakultas
[Link] = "KodeFakultas"
[Link] = !KodeFakultas
End With
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Program Pencarian Pengeluaran
Private Sub cmdEdit_Click()
If VarType(rsPengeluaran(0)) = vbObject Then
MsgBox "Tentukan Data Pengeluaran yang akan diedit!", vbExclamation
Else
Set frmPengeluaran = New frmPengeluaran
[Link]
[Link] = rsPengeluaran(1)
[Link] = rsPengeluaran(2)
[Link] = rsPengeluaran(0)
14
[Link] = rsPengeluaran(3)
[Link] = True
[Link] = True
[Link] = False
[Link] = False
[Link] = True
[Link] = True
[Link] = True
[Link] = True
[Link] = True
End If
Unload Me
End Sub
Private Sub cmdKeluar_Click()
Unload Me
[Link]
End Sub
Private Sub DataGrid1_Click()
End Sub
Private Sub dtcKode_Change()
Set rsFakultas = New [Link]
[Link] = adUseClient
[Link] "SELECT * FROM T_Fakultas where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
[Link] = !NamaFakultas
Set rsPengeluaran = New [Link]
[Link] = adUseClient
[Link] "Select * From Pengeluaran Where KodeFakultas='" &
[Link] & "'", DbCon, adOpenDynamic, adLockOptimistic
Set [Link] = rsPengeluaran
End With
End Sub
Private Sub Form_Load()
BukaDb
Set rsFakultas = New [Link]
[Link] = adUseClient
15
[Link] "SELECT * FROM T_Fakultas ORDER BY KodeFakultas",
DbCon, adOpenDynamic, adLockOptimistic
With rsFakultas
Set [Link] = rsFakultas
[Link] = "KodeFakultas"
[Link] = !KodeFakultas
End With
End Sub
Program Form Cetak Laporan
Dim KodeFakultas As String
Dim TotalPengeluaran, TotalPenerimaan As Long
Private Sub cmdPreview_Click()
Dim r As [Link]
Dim t As [Link]
Dim w As New [Link]
If [Link] = 0 Then
KodeFakultas = "01"
ElseIf [Link] = 1 Then
KodeFakultas = "02"
ElseIf [Link] = 2 Then
KodeFakultas = "03"
ElseIf [Link] = 3 Then
KodeFakultas = "04"
ElseIf [Link] = 4 Then
KodeFakultas = "05"
ElseIf [Link] = 5 Then
KodeFakultas = "06"
End If
If [Link] = 0 Then
Set rsPenerimaan = New [Link]
[Link] = adUseClient
If [Link] = True Then
[Link] "Select
[Link],T_Transaksi.NamaTransaksi,[Link],Peneri
[Link] From Penerimaan,T_Transaksi Where
[Link]=T_Transaksi.KodeTransaksi and
month([Link])=" & [Link] & " and
16
Year([Link])=" & [Link] & " and
[Link]='" & KodeFakultas & "'", DbCon, adOpenDynamic,
adLockOptimistic
Else
[Link] "Select
[Link],T_Transaksi.NamaTransaksi,[Link],Peneri
[Link] From Penerimaan,T_Transaksi Where
[Link]=T_Transaksi.KodeTransaksi and
Year([Link])=" & [Link] & " and
[Link]='" & KodeFakultas & "'", DbCon, adOpenDynamic,
adLockOptimistic
End If
[Link]
With [Link]
.TypeParagraph
.[Link] = "Arial"
.[Link] = 16
.TypeText ("UNIVERSITAS METHODIST INDONESIA")
.TypeText (" ")
.TypeParagraph
.[Link] = 10
.TypeText ("Laporan Penerimaan")
.TypeParagraph
.[Link] = 14
.TypeText ("Fakultas " & [Link])
.TypeParagraph
.TypeText (" ")
End With
Set r = [Link]
[Link] (6)
[Link] (6)
[Link] (0)
[Link] (Chr(13) + Chr(13))
[Link] (0)
Set t = [Link](r, 2, 4)
With t
.Cell(1, 1).[Link] ("KODE PERKIRAAN")
.Cell(1, 2).[Link] ("NAMA PERKIRAAN")
.Cell(1, 3).[Link] ("TANGGAL")
.Cell(1, 4).[Link] ("JUMLAH")
End With
I=1
TotalPenerimaan = 0
If Not [Link] Then
17
[Link]
Do While Not [Link]
I=I+1
[Link](I).Cells(1).[Link] (rsPenerimaan!KodeTransaksi)
[Link](I).Cells(2).[Link] (rsPenerimaan!NamaTransaksi)
[Link](I).Cells(3).[Link] (rsPenerimaan!Tanggal)
[Link](I).Cells(4).[Link] ("Rp." & rsPenerimaan!Jumlah)
[Link]
TotalPenerimaan = TotalPenerimaan + (rsPenerimaan!Jumlah)
[Link]
Loop
End If
[Link](I + 1).Cells(1).[Link] ("Total Penerimaan")
[Link](I + 1).Cells(4).[Link] ("Rp." & TotalPenerimaan)
[Link]
[Link]
[Link] = 9
[Link] = "MS Reference Sans Serif"
[Link] = True
Else
Set rsPengeluaran = New [Link]
[Link] = adUseClient
If [Link] = True Then
[Link] "Select
[Link],T_Transaksi.NamaTransaksi,[Link],Penge
[Link] From Pengeluaran,T_Transaksi Where
[Link]=T_Transaksi.KodeTransaksi and
month([Link])=" & [Link] & " and
Year([Link])=" & [Link] & " and
[Link]='" & KodeFakultas & "'", DbCon, adOpenDynamic,
adLockOptimistic
Else
[Link] "Select
[Link],T_Transaksi.NamaTransaksi,[Link],Penge
[Link] From Pengeluaran,T_Transaksi Where
[Link]=T_Transaksi.KodeTransaksi and
Year([Link])=" & [Link] & " and
[Link]='" & KodeFakultas & "'", DbCon, adOpenDynamic,
adLockOptimistic
End If
[Link]
With [Link]
.TypeParagraph
18
.[Link] = "Arial"
.[Link] = 16
.TypeText ("UNIVERSITAS METHODIST INDONESIA")
.TypeText (" ")
.TypeParagraph
.[Link] = 10
.TypeText ("Laporan Pengeluaran")
.TypeParagraph
.[Link] = 14
.TypeText ("Fakultas " & [Link])
.TypeParagraph
.TypeText (" ")
End With
Set r = [Link]
[Link] (6)
[Link] (6)
[Link] (0)
[Link] (Chr(13) + Chr(13))
[Link] (0)
Set t = [Link](r, 2, 4)
With t
.Cell(1, 1).[Link] ("KODE PERKIRAAN")
.Cell(1, 2).[Link] ("NAMA PERKIRAAN")
.Cell(1, 3).[Link] ("TANGGAL")
.Cell(1, 4).[Link] ("JUMLAH")
End With
I=1
TotalPengeluaran = 0
If Not [Link] Then
[Link]
Do While Not [Link]
I=I+1
[Link](I).Cells(1).[Link] (rsPengeluaran!KodeTransaksi)
[Link](I).Cells(2).[Link] (rsPengeluaran!NamaTransaksi)
[Link](I).Cells(3).[Link] (rsPengeluaran!Tanggal)
[Link](I).Cells(4).[Link] ("Rp." & rsPengeluaran!Jumlah)
[Link]
TotalPengeluaran = TotalPengeluaran + (rsPengeluaran!Jumlah)
[Link]
Loop
End If
[Link](I + 1).Cells(1).[Link] ("Total Pengeluaran")
19
[Link](I + 1).Cells(4).[Link] ("Rp." & TotalPengeluaran)
[Link]
[Link] = 9
[Link] = "MS Reference Sans Serif"
[Link] = True
End If
End Sub
Private Sub cmdSelesai_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim I As Integer
BukaDb
For I = 1 To 12
[Link] I
Next
[Link] "Penerimaan"
[Link] "Pengeluaran"
[Link] = 0
[Link] = 0
[Link] "Kedokteran"
[Link] "Ekonomi"
[Link] "Sastra"
[Link] "Pertanian"
[Link] "Ilmu Komputer"
[Link] "Rektorat"
[Link] = 0
[Link] = True
For I = 1980 To 2015
[Link] I
Next
[Link] = 20
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
20
Private Sub optBulan_Click()
[Link] = True
End Sub
Private Sub optTahun_Click()
If [Link] = True Then
[Link] = False
Else
[Link] = True
End If
End Sub
Modul
Public DbCon As New [Link]
Public rsUtama As New [Link]
Public rsFakultas As New [Link]
Public rsTransaksi As New [Link]
Public rsPenerimaan As New [Link]
Public rsPengeluaran As New [Link]
Public sProses As String, sKunciRec As String
Public Pemanggil As String
Public Pemanggil2 As String
Public rsCari As New [Link]
Public rsCari2 As New [Link]
Public nJumRec As Long
Public Sub BukaDb()
Set DbCon = New [Link]
[Link] = "provider=[Link].4.0;data source =" &
[Link] & "\[Link]"
[Link]
End Sub
21