Hari ini penulis mencoba ingin memberi contoh cara membuat nota prin out penjualan, yah sapa tau bisa dijadikan referensi buat desain tampilan nota agar lebih keren..
yang perlu disiapkan adalah :
buat 2 form dan aktifkan preference microsoft DAO 2.5/3.51, microsoft activex data object library, aktifkan komponen microsoft databoundgrid dan data boundlist.
kemudian desain sesuai contoh.Untuk backgorund bs kalian buat sendiri di adobe photoshop.
dan berikut preview program yang sudah jadi
Dan berikut hasil nota yang dihasilkan jika di print
untuk scriptnya ada disini
' untuk form penjualan
Public dbs As Database
Dim tot As Single
Private Sub chameleonButton1_Click()
Form9.Show
End Sub
Private Sub chameleonButton2_Click()
'On Error Resume Next
End Sub
Private Sub hapus()
'On Error Resume Next
temp.Recordset.MoveFirst
Do
temp.Recordset.Delete
temp.Recordset.MoveNext
Loop Until temp.Recordset.EOF
DBGrid1.Refresh
End Sub
Private Sub Command1_Click()
End Sub
Private Sub Command2_Click()
End Sub
Private Sub DBCombo2_Click(Area As Integer)
'DBGrid2.Visible = True
End Sub
Private Sub DBGrid2_Click()
End Sub
Private Sub Form_Load()
'On Error Resume Next
Dim total As Single
Data1.DatabaseName = App.Path & "\pabrik.mdb"
Dbrg.DatabaseName = App.Path & "\pabrik.mdb"
HPes.DatabaseName = App.Path & "\pabrik.mdb"
DPes.DatabaseName = App.Path & "\pabrik.mdb"
HJual.DatabaseName = App.Path & "\pabrik.mdb"
Djual.DatabaseName = App.Path & "\pabrik.mdb"
temp.DatabaseName = App.Path & "\pabrik.mdb"
Data.DatabaseName = App.Path & "\key.mdb"
Data2.DatabaseName = App.Path & "\key.mdb"
Data2.RecordSource = "jual"
Dbrg.RecordSource = "barang"
Data1.RecordSource = "customer"
HPes.RecordSource = "h_pesan"
DPes.RecordSource = "d_pesan"
HJual.RecordSource = "h_jual"
Djual.RecordSource = "d_jual"
temp.RecordSource = "temp_jual"
Data.RecordSource = "temp"
Set dbs = OpenDatabase(App.Path & "\key.mdb")
Set Data.Recordset = dbs.OpenRecordset("temp", dbOpenDynaset)
On Error Resume Next
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 6
TTglBon.Text = Format(Date, "dd - mm - yyyy")
End Sub
Private Sub CAuto_Click()
On Error Resume Next
Dim NoB As Long
Dim NoL As String
If HJual.Recordset.BOF And HJual.Recordset.EOF Then
NoB = 1
Else
HJual.Recordset.MoveLast
NoB = Val(HJual.Recordset!No_nota) + 1
End If
TNoBon.Text = Left("00000", 6 - Len(Trim(Str(NoB)))) & Trim(Str(NoB))
End Sub
Private Sub DBCombo2_Change()
'On Error Resume Next
HPes.Recordset.Index = "np"
HPes.Recordset.Seek "=", DBCombo2.Text
If Not HPes.Recordset.NoMatch Then
Tcust.Text = HPes.Recordset!kd_cust
Set Data.Recordset = dbs.OpenRecordset("select * from temp where no_pes like '*" & DBCombo2.Text & "*'", dbOpenDynaset)
Do
temp.Recordset.AddNew
temp.Recordset!kd_brg = Data.Recordset!kd_brg
temp.Recordset!grup = Data.Recordset!grup
temp.Recordset!nama = Data.Recordset!nama
temp.Recordset!jumlah = Data.Recordset!jumlah
temp.Recordset!total = Data.Recordset!total
temp.Recordset.Update
temp.Refresh
Data.Recordset.MoveNext
Loop Until Data.Recordset.EOF
tdisc.SetFocus
End If
Dim TTemp As Single
TTemp = 0
On Error Resume Next
temp.Recordset.MoveFirst
Do
TTemp = TTemp + temp.Recordset!total
temp.Recordset.MoveNext
Loop Until temp.Recordset.EOF
ttotal.Caption = Format(TTemp, "###,###,###")
On Error GoTo 0
End Sub
Private Sub TJumlah_KeyPress(KeyAscii As Integer)
On Error Resume Next
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then
Beep
KeyAscii = 0
End If
End Sub
Private Sub Label15_click()
'On Error Resume Next
Dim Jum As Integer
Dim X As Integer
Jum = 0
CAuto_Click
If DBCombo2.Text = "" Then
X = MsgBox("No Pesan belum diisi !!", vbOKOnly)
DBCombo2.SetFocus
Exit Sub
End If
If tbayar.Text = "0" Or tbayar.Text = "" Then
X = MsgBox("Bayar dulu... !!", vbOKOnly)
tbayar.SetFocus
Exit Sub
End If
If HJual.Recordset.BOF = False And HJual.Recordset.EOF = False Then HJual.Recordset.MoveLast
HJual.Recordset.AddNew
HJual.Recordset!No_nota = TNoBon.Text
HJual.Recordset!Tgl_jual = TTglBon.Text
HJual.Recordset!No_pesan = DBCombo2.Text
HJual.Recordset!bayar = tbayar.Text
HJual.Recordset!disc = tdisc.Text
HJual.Recordset!total = tbali.Caption
HJual.Recordset.Update
HJual.Refresh
temp.Recordset.MoveFirst
Do
If Djual.Recordset.BOF = False And Djual.Recordset.EOF = False Then Djual.Recordset.MoveLast
Djual.Recordset.AddNew
Djual.Recordset!No_nota = TNoBon.Text
Djual.Recordset!kd_brg = temp.Recordset!kd_brg
Djual.Recordset!jumlah = temp.Recordset!jumlah
Djual.Recordset.Update
Djual.Refresh
Data2.Recordset.AddNew
Data2.Recordset!No_nota = TNoBon.Text
Data2.Recordset!kd_brg = temp.Recordset!kd_brg
Data2.Recordset!grup = temp.Recordset!grup
Data2.Recordset!nama = temp.Recordset!nama
Data2.Recordset!jumlah = temp.Recordset!jumlah
Data2.Recordset!disc = tdisc.Text
Data2.Recordset!total = temp.Recordset!total
Data2.Recordset!bayar = tbayar.Text
Data2.Recordset.Update
Data2.Refresh
temp.Recordset.MoveNext
Loop Until temp.Recordset.EOF
X = MsgBox("Data sudah tersimpan...,Data mau dicetak ?", vbYesNo, "INFORMASI")
If X = vbYes Then cetak
kosong
DBCombo2.SetFocus
hapus
End Sub
Private Sub kosong()
'On Error Resume Next
hapus
CAuto_Click
DBCombo2.Text = ""
Tcust.Text = ""
tnama.Text = ""
Talamat.Text = ""
Tkota.Text = ""
Ttelp.Text = ""
tdisc.Text = ""
ttotal.Caption = ""
tbayar.Text = ""
tbali.Caption = ""
End Sub
Private Sub cetak()
On Error Resume Next
Dim MGrs As String
MGrs = String$(80, "-")
Printer.CurrentX = 0
Printer.CurrentY = 0
Printer.Font = "Courier New"
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Tab(27); ""
Printer.Print Tab(27); ""
Printer.Print Tab(29); " www.VBthok.co.cc "
Printer.FontBold = False
Printer.Print Tab(25); " JL. Bolak Balik Gang Buntu No .25 "
Printer.Print Tab(18); " Telp.(0341)-xxxxxxx,xxxxx Email: tome.mine@gmail.com"
Printer.Print Tab(27); ""
Printer.Print Tab(29); " N O T A P E N J U A L A N"
Printer.Print
Printer.Print Tab(5); "No.Nota :";
Printer.Print Tab(16); TNoBon.Text;
Printer.Print Tab(58); "Tanggal :";
Printer.Print Tab(63); TTglBon.Text
Printer.Print Tab(3); MGrs
Printer.Print Tab(5); "No_pesan :";
Printer.Print Tab(16); DBCombo2.Text;
Printer.Print Tab(5); "Kd_cust :";
Printer.Print Tab(16); Tcust.Text
Data1.Recordset.Index = "Kc"
Data1.Recordset.Seek "=", Tcust.Text
If Not Data1.Recordset.NoMatch Then
Printer.Print Tab(5); "Nama : ";
Printer.Print Tab(16); Data1.Recordset!nama
Printer.Print Tab(5); "Alamat : ";
Printer.Print Tab(16); Data1.Recordset!Alamat
Printer.Print Tab(5); "Kota : ";
Printer.Print Tab(16); Data1.Recordset!Kota
Printer.Print Tab(5); "Telepon : ";
Printer.Print Tab(16); Data1.Recordset!telp
End If
Printer.Print Tab(3); MGrs
Printer.Print Tab(5); "KODE";
Printer.Print Tab(15); "Grup";
Printer.Print Tab(35); "Nama";
Printer.Print Tab(57); "Jumlah";
Printer.Print Tab(75); "Total"
Printer.Print Tab(3); MGrs
temp.Recordset.MoveFirst
Do
Printer.Print Tab(5); temp.Recordset!kd_brg;
Printer.Print Tab(15); temp.Recordset!grup;
Printer.Print Tab(35); temp.Recordset!nama;
Printer.Print Tab(58); RKanan(temp.Recordset!jumlah, "###0");
Printer.Print Tab(71); RKanan(temp.Recordset!total, "##,###,###")
temp.Recordset.MoveNext
Loop Until temp.Recordset.EOF
Printer.Print Tab(4); MGrs
Printer.Print Tab(55); "SUB TOTAL : ";
Printer.Print Tab(67); "Rp. " & RKanan(ttotal.Caption, "##,###,###") & ",-";
Printer.Print Tab(55); "Disc : ";
Printer.Print Tab(67); tdisc.Text, "%";
Printer.Print Tab(55); "Bayar : ";
Printer.Print Tab(67); "Rp. " & RKanan(tbayar.Text, "##,###,###") & ",-";
Printer.Print Tab(55); "TOTAL : ";
Printer.Print Tab(67); "Rp. " & RKanan(tbali.Caption, "##,###,###") & ",-";
Printer.Print Tab(12); "Hormat Kami,"
Printer.Print Tab(5); ""
Printer.Print Tab(5); ""
Printer.Print Tab(5); ""
Printer.Print Tab(5); "( www.VBthok.co.cc )"
Printer.EndDoc
End Sub
Private Function RKanan(NData, CFormat) As String
On Error Resume Next
RKanan = Format(NData, CFormat)
RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan
End Function
Private Sub Label11_Click()
temp.Refresh
hapus
kosong
End
End Sub
Private Sub Label14_Click()
Form9.Show
End Sub
Private Sub reset_Click()
On Error Resume Next
DBGrid2.Visible = False
lab.Visible = False
lab.Visible = False
temp.Refresh
hapus
kosong
End Sub
Private Sub tbayar_Change()
lab.Visible = True
End Sub
Private Sub tbayar_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = 13 Then
Form9.Show
prev
End If
End Sub
Private Sub tbayar_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Select Case KeyCode
Case Is = vbKeyEscape
Form9.Show
prev
End Select
End Sub
Private Sub Tcust_Change()
'On Error Resume Next
Data1.Recordset.Index = "kc"
Data1.Recordset.Seek "=", Tcust.Text
If Not Data1.Recordset.NoMatch Then
tnama.Text = Data1.Recordset!nama
Talamat.Text = Data1.Recordset!Alamat
Tkota.Text = Data1.Recordset!Kota
Ttelp.Text = Data1.Recordset!telp
End If
End Sub
Private Sub tdisc_KeyPress(KeyAscii As Integer)
On Error Resume Next
DBGrid2.Visible = False
Dim disc As Single
If KeyAscii = 13 Then
disc = ttotal.Caption * tdisc.Text / 100
tbali.Caption = Format(ttotal.Caption - disc, "#,#,0")
tbayar.SetFocus
End If
End Sub
Private Sub prev()
On Error Resume Next
Dim MGrs As String
MGrs = String$(80, "-")
Form9.CurrentX = 0
Form9.CurrentY = 0
Form9.Font = "Courier New"
Form9.FontSize = 10
Form9.FontBold = True
Form9.Print Tab(27); ""
Form9.Print Tab(27); ""
Form9.Print Tab(29); " www.VBthok.co.cc "
Form9.FontBold = False
Form9.Print Tab(25); " JL. Bolak Balik Gang Buntu No .25 "
Form9.Print Tab(18); " Telp.(0341)-xxxxxxx,xxxxx Email: tome.mine@gmail.com"
Form9.Print Tab(27); ""
Form9.Print Tab(29); " N O T A P E N J U A L A N"
Form9.Print
Form9.Print Tab(5); "No.Nota :";
Form9.Print Tab(16); TNoBon.Text;
Form9.Print Tab(58); "Tanggal :";
Form9.Print Tab(68); TTglBon.Text
Form9.Print Tab(3); MGrs
Form9.Print Tab(5); "No_pesan :";
Form9.Print Tab(16); DBCombo2.Text;
Form9.Print Tab(5); "Kd_cust :";
Form9.Print Tab(16); Tcust.Text
Data1.Recordset.Index = "Kc"
Data1.Recordset.Seek "=", Tcust.Text
If Not Data1.Recordset.NoMatch Then
Form9.Print Tab(5); "Nama : ";
Form9.Print Tab(16); Data1.Recordset!nama
Form9.Print Tab(5); "Alamat : ";
Form9.Print Tab(16); Data1.Recordset!Alamat
Form9.Print Tab(5); "Kota : ";
Form9.Print Tab(16); Data1.Recordset!Kota
Form9.Print Tab(5); "Telepon : ";
Form9.Print Tab(16); Data1.Recordset!telp
End If
Form9.Print Tab(3); MGrs
Form9.Print Tab(5); "KODE";
Form9.Print Tab(15); "Grup";
Form9.Print Tab(35); "Nama";
Form9.Print Tab(57); "Jumlah";
Form9.Print Tab(75); "Total"
Form9.Print Tab(3); MGrs
temp.Recordset.MoveFirst
Do
Form9.Print Tab(5); temp.Recordset!kd_brg;
Form9.Print Tab(15); temp.Recordset!grup;
Form9.Print Tab(35); temp.Recordset!nama;
Form9.Print Tab(58); RKanan(temp.Recordset!jumlah, "###0");
Form9.Print Tab(71); RKanan(temp.Recordset!total, "##,###,###")
temp.Recordset.MoveNext
Loop Until temp.Recordset.EOF
Form9.Print Tab(4); MGrs
Form9.Print Tab(55); "SUB TOTAL : ";
Form9.Print Tab(67); "Rp. " & RKanan(ttotal.Caption, "##,###,###") & ",-";
Form9.Print Tab(55); "Disc : ";
Form9.Print Tab(67); tdisc.Text, "%";
Form9.Print Tab(55); "Bayar : ";
Form9.Print Tab(67); "Rp. " & RKanan(tbayar.Text, "##,###,###") & ",-";
Form9.Print Tab(55); "TOTAL : ";
Form9.Print Tab(67); "Rp. " & RKanan(tbali.Caption, "##,###,###") & ",-";
Form9.Print Tab(12); "Hormat Kami,"
Form9.Print Tab(5); ""
Form9.Print Tab(5); ""
Form9.Print Tab(5); ""
Form9.Print Tab(5); "( www.VBthok.co.cc )"
End Sub
Private Sub Timer1_Timer()
lab.ForeColor = QBColor(Rnd * 15)
End Sub
'untuk form preview
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Select Case KeyCode
Case Is = vbKeyEscape
Unload Me
End Select
End Sub
Private Sub Form_Load()
On Error Resume Next
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 6
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Label1.ForeColor = QBColor(Rnd * 15)
End Sub
Oke deeh cukup segitu aja script kodenya, mudah khann?? hehehe kalo kalian msh bingung neh silakan donlot source codenya disini
4 komentar:
ane ian..
muantap bloge juragan, tengkiu ya.. ;)
Om thanks dah sharing,,, bagus ni buat referensi, tapi yang support itu VB versi berapa sih???
ngisi barangnya gmn?
ngisi harga gmn?
ngisi nama pemesan gmn?
ko gk bs,kurang fungsional itu,gk bisa di simpan jg,gk ada tombol untuk pencarian data.
NB:aku pake sring eror,pa lg cetak.
apa kalo di print pake epson LX 800 pake kertas gulung. dapat langsung berhenti ngeprit kalo pake end doc dan tidak ada sisa kertas.
Posting Komentar