Senin, 08 Juni 2015
listing form ganti password vb2 mi (oke)
Private Sub btutup_Click()
Unload Me
FRMMENU.Show
End Sub
Private Sub Form_Activate()
For Each k In Me.Controls
If TypeOf k Is TextBox Then
k.Enabled = False
End If
Next
tkduser = FRMMENU.STBAR.Panels(1).Text
tlama.Enabled = True
tlama.SetFocus
tlama.PasswordChar = "*"
tbaru.PasswordChar = "*"
tkonf.PasswordChar = "*"
End Sub
Private Sub tbaru_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
tkonf.Enabled = True
tkonf.SetFocus
End If
End Sub
Private Sub tkonf_KeyPress(KeyAscii As Integer)
Call koneksi
If KeyAscii = 13 Then
If tkonf.Text <> tbaru.Text Then
MsgBox "konfirmasi dari password baru berbeda"
Else
rsuser.Open "update user set password='" & tkonf.Text & "' where kodeuser='" & tkduser.Text & "'", KON
MsgBox "password telah diupdate"
Call Form_Activate
tlama = ""
tbaru = ""
tkonf = ""
End If
End If
End Sub
Private Sub tlama_KeyPress(KeyAscii As Integer)
Call koneksi
If KeyAscii = 13 Then
rsuser.Open "select* from user where password='" & tlama.Text & "'", KON
If rsuser.EOF Then
MsgBox "password " + tlama.Text + " tidak ada"
tlama.SetFocus
Else
tbaru.Enabled = True
tbaru.SetFocus
End If
End If
End Sub
listing form laporan vb2 mi (oke)
Private Sub bcetak_Click()
crbarang.ReportFileName = App.Path & "\laporan_barang.rpt"
crbarang.WindowState = crptMaximized
crbarang.RetrieveDataFiles
crbarang.Action = 1
End Sub
Private Sub bkeluar_Click()
Unload Me
FRMMENU.Show
End Sub
Private Sub cbulan_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub charian_Click()
crpenjualan.SelectionFormula = "Totext ({transaksi.tgljual})='" & charian & "'"
crpenjualan.ReportFileName = App.Path & "\laporan_harian.rpt"
crpenjualan.WindowState = crptMaximized
crpenjualan.RetrieveDataFiles
crpenjualan.Action = 1
End Sub
Private Sub charian_KeyPress(KeyAscii As Integer)
If charian = "" Or KeyAscii = 27 Then Unload Me
End Sub
Private Sub cmingguanakhir_Click()
If cmingguanawal = "" Then
MsgBox "Tanggal Awal Kosong", , "Informasi"
cmingguanawal.SetFocus
Exit Sub
End If
crpenjualan.SelectionFormula = "{transaksi.tgljual} in date (" & cmingguanawal.Text & ") to date (" & cmingguanakhir.Text & ")"
crpenjualan.ReportFileName = App.Path & "\laporan_mingguan.rpt"
crpenjualan.WindowState = crptMaximized
crpenjualan.RetrieveDataFiles
crpenjualan.Action = 1
End Sub
Private Sub cmingguanawal_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then Unload Me
End Sub
Private Sub ctahun_Click()
Call koneksi
rstrans.Open "select* from transaksi where month(tgljual)='" & Val(cbulan) & "' and year(tgljual)='" & Val(ctahun) & "'", KON
If rstrans.EOF Then
MsgBox "Data tidak ditemukan"
Exit Sub
cbulan.SetFocus
End If
crpenjualan.SelectionFormula = "Month({transaksi.tgljual})=" & Val(cbulan.Text) & " and Year({transaksi.tgljual})=" & Val(ctahun.Text)
crpenjualan.ReportFileName = App.Path & "\laporan_bulanan.rpt"
crpenjualan.WindowState = crptMaximized
crpenjualan.RetrieveDataFiles
crpenjualan.Action = 1
End Sub
Private Sub Form_Load()
Call koneksi
rstrans.Open "select Distinct tgljual from transaksi order by 1", KON
rstrans.Requery
Do Until rstrans.EOF
charian.AddItem rstrans!tgljual
cmingguanawal.AddItem Format(rstrans!tgljual, "YYYY, MM, DD")
cmingguanakhir.AddItem Format(rstrans!tgljual, "YYYY, MM, DD")
rstrans.MoveNext
Loop
For i = 1 To 12
cbulan.AddItem i
Next i
For i = 10 To 20
ctahun.AddItem 2000 + i
Next i
End Sub
Rabu, 03 Juni 2015
listing form transaksi vb2 mi (oke)
Dim ambilstok As Boolean
Sub cetak()
Call koneksi
cr.SelectionFormula = "{transaksi.notransaksi}='" & tnotrans & "'"
cr.ReportFileName = App.Path & "\cetak2.rpt"
cr.WindowState = crptNormal
cr.RetrieveDataFiles
cr.Action = 1
End Sub
Sub isilist()
rsbrg.Open "select* from barang", KON
List1.Clear
Do While Not rsbrg.EOF
List1.AddItem rsbrg!kodebarang & Space(10) & rsbrg!namabarang & Space(3) & rsbrg!stok
rsbrg.MoveNext
Loop
End Sub
Sub semula()
Call bersih
Call nonaktif
bsimpan.Enabled = False
binput.Enabled = True
btutup.Enabled = True
bbatal.Enabled = False
blistbarang.Enabled = False
List1.Visible = False
End Sub
Sub nonaktif()
Dim kontrol As Control
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Enabled = False
Next
List1.Enabled = False
End Sub
Sub aktif()
Dim kontrol As Control
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Enabled = True
Next
List1.Enabled = True
ttgl.Enabled = False
tuser.Enabled = False
End Sub
Sub bersih()
Dim kontrol As Control
lbayar.Caption = "Bayar"
Call hapusTEMP
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Text = ""
Next
tuser = FRMMENU.STBAR.Panels(1).Text
End Sub
Sub tampilgrid()
Call koneksi
rstemp.Open "select* from TEMP", KON
Set grid.DataSource = rstemp
grid.ColWidth(0) = 100
grid.ColWidth(1) = 1200
grid.ColWidth(2) = 1800
grid.ColWidth(3) = 1000
grid.ColWidth(4) = 1500
grid.ColWidth(5) = 1000
grid.ColWidth(6) = 1700
grid.TextMatrix(0, 1) = "Kode Barang"
grid.TextMatrix(0, 2) = "Nama Barang"
grid.TextMatrix(0, 3) = "Satuan"
grid.TextMatrix(0, 4) = "Harga"
grid.TextMatrix(0, 5) = "Jumlah Jual"
grid.TextMatrix(0, 6) = "Subtotal"
End Sub
Sub bikinTEMP()
bikin = "create table TEMP(kodebarang varchar(7),nmbrg varchar(25),sat varchar(10),hrg double,qty int,subttl double)"
KON.Execute (bikin)
tampilgrid
End Sub
Sub hapusTEMP()
hapus = "drop table if exists TEMP"
KON.Execute (hapus)
End Sub
Sub simpanTEMP()
simpan = "insert into TEMP() values('" & tkdbrg & "','" & tnmbrg & "','" & tsatuan & "','" & tharga & "','" & tjumlah & "','" & tsubtotal & "')"
KON.Execute (simpan)
End Sub
Sub nomor()
ttgl = Format(Date, "DD/MM/YYYY")
'Dim cari As String
Call koneksi
rstrans.Open "select* from transaksi order by notransaksi desc", KON
With rstrans
If .EOF Then
tnotrans = Format(Date, "yymm") + "001"
ElseIf Left(rstrans!notransaksi, 4) <> Format(Date, "yymm") Then
tnotrans = Format(Date, "yymm") + "001"
Else
NO = .Fields("notransaksi") + 1
tnotrans = Format(Date, "yymm") + Right("000" + NO, 3)
End If
End With
End Sub
Sub simpantransaksijual()
ttgl = Format(Date, "YYYY/MM/DD")
simpan = "insert into transaksi() values('" & tnotrans & "','" & ttgl & "','" & Val(lbayar) & "','" & tuser & "')"
KON.Execute (simpan)
End Sub
Sub simpandetailjual()
Dim simpan, fak, kdbrg As String
Dim jumlah As Integer
Dim subtotal As Double
For A = 1 To (grid.Rows - 1)
fak = tnotrans
kdbrg = grid.TextMatrix(A, 1)
jumlah = grid.TextMatrix(A, 5)
subtotal = grid.TextMatrix(A, 6)
simpan = "insert into detailtransaksi() values('" & fak & "','" & Val(jumlah) & "','" & Val(subtotal) & "','" & kdbrg & "')"
Set rsdetail = KON.Execute(simpan)
Next A
End Sub
Sub ubahstok()
'Dim jumlah As Integer
Call koneksi
If ambilstok = True Then
kurang = "update barang set stok=stok - '" & Val(tjumlah) & "' where kodebarang='" & tkdbrg & "'"
Set rsbrg = KON.Execute(kurang)
ElseIf ambilstok = False Then
tambah = "update barang set stok=stok + '" & Val(tjumlah) & "' where kodebarang='" & tkdbrg & "'"
Set rsbrg = KON.Execute(tambah)
End If
End Sub
Private Sub bbatal_Click()
Call semula
Call hapusTEMP
End Sub
Private Sub binput_Click()
Call aktif
tnotrans.Enabled = False
binput.Enabled = False
btutup.Enabled = False
bsimpan.Enabled = True
bbatal.Enabled = True
blistbarang.Enabled = True
Call hapusTEMP
Call bikinTEMP
Call nomor
tkdbrg.SetFocus
End Sub
Private Sub blistbarang_Click()
List1.Visible = True
End Sub
Private Sub bsimpan_Click()
Call simpantransaksijual
Call simpandetailjual
x = MsgBox("cetak?", vbYesNo, "cetak")
If x = vbYes Then
Call cetak
y = "delete from temp"
KON.Execute (y)
Call tampilgrid
Call semula
Else
Call tampilgrid
Call semula
End If
End Sub
Private Sub btutup_Click()
Call hapusTEMP
Unload Me
FRMMENU.Show
End Sub
Private Sub Form_Activate()
tnotrans.Enabled = False
Call semula
tuser = FRMMENU.STBAR.Panels(1).Text
End Sub
Private Sub Form_Load()
Call koneksi
ambilstok = True
Call isilist
End Sub
Private Sub grid_KeyPress(KeyAscii As Integer)
A = grid.Row
kodegrid = grid.TextMatrix(A, 1)
Call koneksi
rstemp.Open "select* from TEMP", KON
With rstemp
If KeyAscii = 8 Then
If Not (.BOF And .EOF) Then
h = MsgBox("bener mau dihapus?", vbQuestion + vbYesNo, "--TaNyA--")
If h = vbYes Then
hapus = "delete from TEMP where kodebarang='" & kodegrid & "'"
Set rstemp = KON.Execute(hapus)
ambilstok = False
Call ubahstok
Call isilist
Me.List1.Refresh
grid.Refresh
tkdbrg.Text = ""
tnmbrg.Text = ""
tsatuan.Text = ""
tharga.Text = ""
tjumlah.Text = ""
tsubtotal.Text = ""
ttl = Val(lbayar.Caption)
x = Val(grid.TextMatrix(A, 6))
ttl = ttl - x
lbayar.Caption = ttl
End If
End If
End If
End With
Call tampilgrid
grid.Refresh
End Sub
Private Sub List1_Click()
brg = "select* from barang where kodebarang='" & Left(List1, 7) & "'"
Set rsbrg = KON.Execute(brg)
tkdbrg = rsbrg!kodebarang
tnmbrg = rsbrg!namabarang
tsatuan = rsbrg!satuan
tharga = rsbrg!hargasatuan
tjumlah.SetFocus
List1.Visible = False
End Sub
Private Sub tbayar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(lbayar) > Val(tbayar) Then
MsgBox "uang bayar kurang"
tbayar.SetFocus
tkembali.Enabled = False
Else
tkembali.Enabled = True
tkembali = Val(tbayar) - Val(lbayar)
bsimpan.SetFocus
End If
End If
End Sub
Private Sub Timer1_Timer()
ttgl = Format(Date, "DD/MM/YYYY")
End Sub
Private Sub tjumlah_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call koneksi
rsbrg.Open "select* from barang where kodebarang='" & tkdbrg & "'", KON
If Val(tjumlah) > rsbrg!stok Then
MsgBox "stok kurang"
tjumlah.SetFocus
Exit Sub
Else
tsubtotal = Val(tjumlah) * Val(tharga)
ambilstok = True
Call ubahstok
Call simpanTEMP
Call tampilgrid
Call isilist
ttl = 0
For A = 1 To (grid.Rows - 1)
x = Val(grid.TextMatrix(A, 6))
ttl = ttl + x
Next A
lbayar.Caption = ttl
t = MsgBox("mau tambah pembelian lagi?", vbQuestion + vbYesNo, "Konfirmasi")
If t = vbYes Then
tkdbrg = ""
tkdbrg.SetFocus
tnmbrg = ""
tsatuan = ""
tharga = ""
tjumlah = ""
tsubtotal = ""
Else
ambilstok = False
Me.Refresh
grid.Refresh
tbayar.SetFocus
End If
End If
End If
End Sub
Private Sub tkdbrg_KeyPress(KeyAscii As Integer)
Call koneksi
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
rsbrg.Open "select* from barang where kodebarang='" & tkdbrg & "'", KON
With rsbrg
If .BOF And .EOF Then
psn = MsgBox("KD " + tkdbrg + "TDK ADA", vbInformation, "KONF")
tkdbrg = ""
tkdbrg.SetFocus
Else
tnmbrg = .Fields("namabarang")
tsatuan = .Fields("satuan")
tharga = .Fields("hargasatuan")
tjumlah.Enabled = True
tjumlah.SetFocus
End If
End With
End If
End Sub
Sub cetak()
Call koneksi
cr.SelectionFormula = "{transaksi.notransaksi}='" & tnotrans & "'"
cr.ReportFileName = App.Path & "\cetak2.rpt"
cr.WindowState = crptNormal
cr.RetrieveDataFiles
cr.Action = 1
End Sub
Sub isilist()
rsbrg.Open "select* from barang", KON
List1.Clear
Do While Not rsbrg.EOF
List1.AddItem rsbrg!kodebarang & Space(10) & rsbrg!namabarang & Space(3) & rsbrg!stok
rsbrg.MoveNext
Loop
End Sub
Sub semula()
Call bersih
Call nonaktif
bsimpan.Enabled = False
binput.Enabled = True
btutup.Enabled = True
bbatal.Enabled = False
blistbarang.Enabled = False
List1.Visible = False
End Sub
Sub nonaktif()
Dim kontrol As Control
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Enabled = False
Next
List1.Enabled = False
End Sub
Sub aktif()
Dim kontrol As Control
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Enabled = True
Next
List1.Enabled = True
ttgl.Enabled = False
tuser.Enabled = False
End Sub
Sub bersih()
Dim kontrol As Control
lbayar.Caption = "Bayar"
Call hapusTEMP
For Each kontrol In Me.Controls
If TypeOf kontrol Is TextBox Then kontrol.Text = ""
Next
tuser = FRMMENU.STBAR.Panels(1).Text
End Sub
Sub tampilgrid()
Call koneksi
rstemp.Open "select* from TEMP", KON
Set grid.DataSource = rstemp
grid.ColWidth(0) = 100
grid.ColWidth(1) = 1200
grid.ColWidth(2) = 1800
grid.ColWidth(3) = 1000
grid.ColWidth(4) = 1500
grid.ColWidth(5) = 1000
grid.ColWidth(6) = 1700
grid.TextMatrix(0, 1) = "Kode Barang"
grid.TextMatrix(0, 2) = "Nama Barang"
grid.TextMatrix(0, 3) = "Satuan"
grid.TextMatrix(0, 4) = "Harga"
grid.TextMatrix(0, 5) = "Jumlah Jual"
grid.TextMatrix(0, 6) = "Subtotal"
End Sub
Sub bikinTEMP()
bikin = "create table TEMP(kodebarang varchar(7),nmbrg varchar(25),sat varchar(10),hrg double,qty int,subttl double)"
KON.Execute (bikin)
tampilgrid
End Sub
Sub hapusTEMP()
hapus = "drop table if exists TEMP"
KON.Execute (hapus)
End Sub
Sub simpanTEMP()
simpan = "insert into TEMP() values('" & tkdbrg & "','" & tnmbrg & "','" & tsatuan & "','" & tharga & "','" & tjumlah & "','" & tsubtotal & "')"
KON.Execute (simpan)
End Sub
Sub nomor()
ttgl = Format(Date, "DD/MM/YYYY")
'Dim cari As String
Call koneksi
rstrans.Open "select* from transaksi order by notransaksi desc", KON
With rstrans
If .EOF Then
tnotrans = Format(Date, "yymm") + "001"
ElseIf Left(rstrans!notransaksi, 4) <> Format(Date, "yymm") Then
tnotrans = Format(Date, "yymm") + "001"
Else
NO = .Fields("notransaksi") + 1
tnotrans = Format(Date, "yymm") + Right("000" + NO, 3)
End If
End With
End Sub
Sub simpantransaksijual()
ttgl = Format(Date, "YYYY/MM/DD")
simpan = "insert into transaksi() values('" & tnotrans & "','" & ttgl & "','" & Val(lbayar) & "','" & tuser & "')"
KON.Execute (simpan)
End Sub
Sub simpandetailjual()
Dim simpan, fak, kdbrg As String
Dim jumlah As Integer
Dim subtotal As Double
For A = 1 To (grid.Rows - 1)
fak = tnotrans
kdbrg = grid.TextMatrix(A, 1)
jumlah = grid.TextMatrix(A, 5)
subtotal = grid.TextMatrix(A, 6)
simpan = "insert into detailtransaksi() values('" & fak & "','" & Val(jumlah) & "','" & Val(subtotal) & "','" & kdbrg & "')"
Set rsdetail = KON.Execute(simpan)
Next A
End Sub
Sub ubahstok()
'Dim jumlah As Integer
Call koneksi
If ambilstok = True Then
kurang = "update barang set stok=stok - '" & Val(tjumlah) & "' where kodebarang='" & tkdbrg & "'"
Set rsbrg = KON.Execute(kurang)
ElseIf ambilstok = False Then
tambah = "update barang set stok=stok + '" & Val(tjumlah) & "' where kodebarang='" & tkdbrg & "'"
Set rsbrg = KON.Execute(tambah)
End If
End Sub
Private Sub bbatal_Click()
Call semula
Call hapusTEMP
End Sub
Private Sub binput_Click()
Call aktif
tnotrans.Enabled = False
binput.Enabled = False
btutup.Enabled = False
bsimpan.Enabled = True
bbatal.Enabled = True
blistbarang.Enabled = True
Call hapusTEMP
Call bikinTEMP
Call nomor
tkdbrg.SetFocus
End Sub
Private Sub blistbarang_Click()
List1.Visible = True
End Sub
Private Sub bsimpan_Click()
Call simpantransaksijual
Call simpandetailjual
x = MsgBox("cetak?", vbYesNo, "cetak")
If x = vbYes Then
Call cetak
y = "delete from temp"
KON.Execute (y)
Call tampilgrid
Call semula
Else
Call tampilgrid
Call semula
End If
End Sub
Private Sub btutup_Click()
Call hapusTEMP
Unload Me
FRMMENU.Show
End Sub
Private Sub Form_Activate()
tnotrans.Enabled = False
Call semula
tuser = FRMMENU.STBAR.Panels(1).Text
End Sub
Private Sub Form_Load()
Call koneksi
ambilstok = True
Call isilist
End Sub
Private Sub grid_KeyPress(KeyAscii As Integer)
A = grid.Row
kodegrid = grid.TextMatrix(A, 1)
Call koneksi
rstemp.Open "select* from TEMP", KON
With rstemp
If KeyAscii = 8 Then
If Not (.BOF And .EOF) Then
h = MsgBox("bener mau dihapus?", vbQuestion + vbYesNo, "--TaNyA--")
If h = vbYes Then
hapus = "delete from TEMP where kodebarang='" & kodegrid & "'"
Set rstemp = KON.Execute(hapus)
ambilstok = False
Call ubahstok
Call isilist
Me.List1.Refresh
grid.Refresh
tkdbrg.Text = ""
tnmbrg.Text = ""
tsatuan.Text = ""
tharga.Text = ""
tjumlah.Text = ""
tsubtotal.Text = ""
ttl = Val(lbayar.Caption)
x = Val(grid.TextMatrix(A, 6))
ttl = ttl - x
lbayar.Caption = ttl
End If
End If
End If
End With
Call tampilgrid
grid.Refresh
End Sub
Private Sub List1_Click()
brg = "select* from barang where kodebarang='" & Left(List1, 7) & "'"
Set rsbrg = KON.Execute(brg)
tkdbrg = rsbrg!kodebarang
tnmbrg = rsbrg!namabarang
tsatuan = rsbrg!satuan
tharga = rsbrg!hargasatuan
tjumlah.SetFocus
List1.Visible = False
End Sub
Private Sub tbayar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(lbayar) > Val(tbayar) Then
MsgBox "uang bayar kurang"
tbayar.SetFocus
tkembali.Enabled = False
Else
tkembali.Enabled = True
tkembali = Val(tbayar) - Val(lbayar)
bsimpan.SetFocus
End If
End If
End Sub
Private Sub Timer1_Timer()
ttgl = Format(Date, "DD/MM/YYYY")
End Sub
Private Sub tjumlah_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call koneksi
rsbrg.Open "select* from barang where kodebarang='" & tkdbrg & "'", KON
If Val(tjumlah) > rsbrg!stok Then
MsgBox "stok kurang"
tjumlah.SetFocus
Exit Sub
Else
tsubtotal = Val(tjumlah) * Val(tharga)
ambilstok = True
Call ubahstok
Call simpanTEMP
Call tampilgrid
Call isilist
ttl = 0
For A = 1 To (grid.Rows - 1)
x = Val(grid.TextMatrix(A, 6))
ttl = ttl + x
Next A
lbayar.Caption = ttl
t = MsgBox("mau tambah pembelian lagi?", vbQuestion + vbYesNo, "Konfirmasi")
If t = vbYes Then
tkdbrg = ""
tkdbrg.SetFocus
tnmbrg = ""
tsatuan = ""
tharga = ""
tjumlah = ""
tsubtotal = ""
Else
ambilstok = False
Me.Refresh
grid.Refresh
tbayar.SetFocus
End If
End If
End If
End Sub
Private Sub tkdbrg_KeyPress(KeyAscii As Integer)
Call koneksi
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
rsbrg.Open "select* from barang where kodebarang='" & tkdbrg & "'", KON
With rsbrg
If .BOF And .EOF Then
psn = MsgBox("KD " + tkdbrg + "TDK ADA", vbInformation, "KONF")
tkdbrg = ""
tkdbrg.SetFocus
Else
tnmbrg = .Fields("namabarang")
tsatuan = .Fields("satuan")
tharga = .Fields("hargasatuan")
tjumlah.Enabled = True
tjumlah.SetFocus
End If
End With
End If
End Sub
Langganan:
Komentar (Atom)