Jumat, 31 Agustus 2012

Tampilkan Record Kosong


adobarang.RecordSource = "select * from barang where nama_barang  is Null"
adobarang.Refresh

Kamis, 30 Agustus 2012

Form Login (Tampilkan Foto)


Private Sub txtkodeuser_Change()
If adouser.Recordset.RecordCount = 0 Then Exit Sub
If txtkodeuser.Text <> "" Then
    adouser.Recordset.MoveFirst
    adouser.Recordset.Find "[kodeuser]= '" & txtkodeuser.Text & "'"
    If Not (adouser.Recordset.EOF Or adouser.Recordset.BOF) Then
        txtnamauser.Text = adouser.Recordset!namauser
        txtjabatan.Text = adouser.Recordset!jabatan
        var_password = adouser.Recordset!Password
    End If
Else
        txtnamauser.Text = ""
        txtjabatan.Text = ""
        var_password = ""
        Imgfoto.Picture = Nothing
End If
End Sub

TAMPILKAN DATA DAN FOTO

Private Sub txtpassword_GotFocus()
If adouser.Recordset.RecordCount = 0 Then Exit Sub
adouser.Recordset.MoveFirst
adouser.Recordset.Find "[kodeuser]= '" & txtkodeuser.Text & "'"
If Not adouser.Recordset.EOF Then
                On Error GoTo pesan
                If Not IsNull(adouser.Recordset!foto) Then
                Imgfoto.Picture = LoadPicture(adouser.Recordset!foto)
                End If
                Exit Sub
pesan: MsgBox ("Maaf, path anda salah Jadi fotonya tidak tampil")
Imgfoto.Picture = Nothing
       
        Exit Sub
End If


Form Untuk Mengakses Image


TOMBOL BROWSE
Private Sub cmdbrowse_Click()
CD.ShowOpen
Image1.Picture = LoadPicture(CD.FileName)
XFOTO = CD.FileName
txtfoto.Text = XFOTO
End Sub


TOMBOL SIMPAN


Private Sub cmdsimpan_Click()
If txtkodeuser.Text = "" Then Exit Sub
adouser.Recordset.MoveFirst
adouser.Recordset.Find "[KodeUser]= '" & txtkodeuser.Text & "' "
If adouser.Recordset.EOF Then
    adouser.Recordset.AddNew
End If
    adouser.Recordset!kodeuser = txtkodeuser.Text
    adouser.Recordset!namauser = Trim(txtnamauser.Text)
    adouser.Recordset!jabatan = Trim(txtjabatan.Text)
    adouser.Recordset!Password = Trim(txtpassword.Text)
    adouser.Recordset!foto = Trim(txtfoto.Text)
adouser.Recordset.Update
adouser.Refresh
kosongkan
Call MsgBox("Data Telah Tersimpan", vbInformation, "Simpan Data")
End Sub

TAMPILKAN DATA


Private Sub txtkodeuser_Change1()
If txtkodeuser.Text <> "" Then
    adouser.Recordset.Filter = "KodeUser Like '*" & txtkodeuser.Text & "*' "
    If Not (adouser.Recordset.EOF Or adouser.Recordset.BOF) Then
        txtnamauser.Text = adouser.Recordset!namauser
        txtjabatan.Text = adouser.Recordset!jabatan
        txtpassword.Text = adouser.Recordset!Password
                On Error GoTo pesan
                If Not IsNull(adouser.Recordset!foto) Then
                txtfoto.Text = adouser.Recordset!foto
               Image1.Picture = LoadPicture(adouser.Recordset!foto)
                End If
                Exit Sub
pesan: MsgBox ("Maaf, path anda salah Jadi fotonya tidak tampil")

        
        Exit Sub
    Else
        adouser.Refresh
txtnamauser.Text = ""
txtjabatan.Text = ""
txtpassword.Text = ""
txtfoto.Text = ""
Image1.Picture = Nothing
        
        Exit Sub
    End If
Else
adouser.Refresh
kosongkan
Exit Sub
End If
End Sub


Membuat View Laporan Periodik di MySQL


create
view `pos`.`view_jual_periodik`
as
(SELECT jual.tanggaljual, jual.nota, item_jual.kodebarang, barang.namabarang, barang.hargajual, item_jual.jumlahjual, (hargajual*jumlahjual) AS subtotal
FROM (jual INNER JOIN item_jual ON jual.nota = item_jual.nota) INNER JOIN barang ON item_jual.kodebarang = barang.kodebarang)

Code Print ke Printer OPOS (Printer Kasir)



Option Explicit
Dim CRLF    As String * 2
Dim ESC     As String * 1
Dim no As Integer
Dim statchg As Integer
Dim gtotal As Double
Dim gdisk As Double
Dim gst As Double
Dim MSOLD As Integer
Dim MONHAND As Integer
Dim KODEx As String


Private Sub printSTRUK1()
    Dim fDate   As String
    Dim fTime   As String
    Dim RecNo   As Long
    Dim fRecNo  As String
    Dim ManualCut   As String
    Dim OutputData As String
    Dim totalall As Double
    Dim diskall As Double
    Dim stall As Double
    Dim chg As Double
    Dim ttl As Double
    Dim mnotran As Double
 
   ' Printer.Print SetBitmap; App.Path + "\mbb001.bmp";
      Printer.FontSize = 9
      Printer.FontBold = True
      Picture = LoadPicture
   
      'Printer.PaintPicture(
      Printer.Print "TAMAN BALITA MERBY      "
      Printer.Print " "
      Printer.FontSize = 7
      Printer.FontBold = False
      Printer.Print " Jl. PANDANARAN II/2D SEMARANG"
      Printer.Print "         Telp: 024-8317067"
      Printer.Print " "
      Printer.Print " "
       fDate = Format(Date, "dd-mm-yyyy")   'System date
       fTime = Format(Time, "hh:mm")            'System time
       RecNo = 1                               'Receipt No.
       fRecNo = Format(RecNo, "R-0000")
        Printer.FontSize = 9
        Printer.FontBold = False
        Printer.Print "  "; fDate; "                          "; fTime
        Printer.Print " "
        Printer.FontSize = 9
        Printer.FontBold = True
        Printer.Print "      BUKTI PEMBAYARAN "
        Printer.Print
        Printer.FontSize = 8
        Printer.FontBold = False
        ST00TEMP.RecordSource = "select * from st00temp"
        ST00TEMP.Refresh
        Do While Not ST00TEMP.Recordset.EOF
           Printer.Print Str(ST00TEMP.Recordset.Fields("qty")); "  "; ST00TEMP.Recordset.Fields("name"); Space(26 - Len(ST00TEMP.Recordset.Fields("name"))); Space(9 - Len(Format(ST00TEMP.Recordset.Fields("price"), "#,#0"))); Format(ST00TEMP.Recordset.Fields("price"), "#,#0")
           totalall = totalall + ST00TEMP.Recordset.Fields("total")
           diskall = diskall + ST00TEMP.Recordset.Fields("discpct")
           ttl = ST00TEMP.Recordset.Fields("price") * ST00TEMP.Recordset.Fields("qty")
           mnotran = ST00TEMP.Recordset.Fields("notran")
           ST00TEMP.Recordset.MoveNext
           Loop
           Printer.Print " "
           Printer.FontSize = 10
           Printer.FontBold = True
           Printer.Print "SubTotal  :"; Space(9 - Len(Format(stall, "#,#0"))); Format(stall, "#,#0")
           Printer.Print "Disk      :"; Space(9 - Len(Format(diskall, "#,#0"))); Format(diskall, "#,#0")
           Printer.Print "Total     :"; Space(9 - Len(Format(totalall, "#,#0"))) + Format(totalall, "#,#0")
           Printer.Print " "
           'Printer.PaintPicture
           Printer.FontSize = 9
           Printer.FontBold = False
           Printer.Print "CASH      :"; Space(15 - Len(totalall)) + IIf(Val(Text2(1).Text) = "0", Format(totalall, "#,#0"), Format(Val(Text2(1).Text), "#,#0"))
           Printer.Print "KEMBALI   :"; Space(15 - Len(Text2(2).Text)) + Format(Val(Text2(2).Text), "#,#0")
           Printer.Print "  "
           Printer.Print "Cashier : "; xuser; "    RPC   :"; Space(3 - Len(Format(mnotran, "#,#0"))); Format(mnotran, "#,#0")
           Printer.Print "  "
           Printer.Print "     Terima Kasih Selamat Bergabung"
 Printer.EndDoc
 End Sub

Simpan Data Dengan Cara Looping

CARA 1
Private Sub transdata()
   Dim i As Integer
   INV.RecordSource = "select * from inv ORDER BY KODE"
   INV.Refresh
   ST00TEMP.RecordSource = "select * from st00temp"
   ST00TEMP.Refresh
   ST000000.RecordSource = "select * from st000000"
   ST000000.Refresh
   Do While Not ST00TEMP.Recordset.EOF
     ST000000.Recordset.AddNew
     For i = 0 To 10
        ST000000.Recordset.Fields(i) = ST00TEMP.Recordset.Fields(i)
     Next
   ST000000.Recordset.Update
   End If
   ST00TEMP.Recordset.MoveNext
   Loop

On Error Resume Next
 MsgBox "Please Wait while Print.......", vbOKOnly + vbInformation
 ST00TEMP.RecordSource = "delete * from st00temp"
 ST00TEMP.Refresh
 ST00TEMP.RecordSource = " select * from st00temp"
 ST00TEMP.Refresh
 DataGrid1.ReBind
End Sub

CARA 2

       Do While Not Adodc1.Recordset.EOF
       With ST00TEMP.Recordset
         .AddNew
         .Fields("notran") = no
         .Fields("PLU") = Adodc1.Recordset.Fields("Paket")
         .Fields("name") = Adodc1.Recordset.Fields("Barang")
         .Fields("qty") = Text4.Text
         .Fields("price") = "0" 'Adodc1.Recordset.Fields("harga")
         .Fields("total") = "0" 'Text4.Text * Adodc1.Recordset.Fields("harga")
         .Fields("discpct") = Text7.Text
         '.Fields("flag") = Text6.Text
         .Fields("tgl") = Date
         .Fields("jam") = Time
         .Update
       End With
       Adodc1.Recordset.MoveNext
       Loop

Message Box


Select Case MsgBox("Apakah Yakin data ini akan di hapus?", vbYesNo Or vbExclamation Or vbDefaultButton1, "Peringatan")
   
        Case vbYes
            adopasien.Recordset.Delete adAffectCurrent
            adopasien.Refresh
        Case vbNo
   
End Select

Membuat Laporan By Faktur


Private Sub CMDCETAK_Click()
CR.SelectionFormula = "{view_beli_perfaktur.faktur}= '" & txtfaktur.Text & "' "
CR.ReportFileName = App.Path & "\Laporan\Laporan Pembelian Per Faktur.rpt"
CR.WindowState = crptMaximized
CR.RetrieveDataFiles
CR.PrintReport
End Sub

Membuat Laporan Periodik


ISI COMBOBOX TANGGAL AWAL DAN TANGGAL AKHIR SESUAI DATA YANG ADA DALAM TABEL 
Private Sub Form_Load()
KONEKSI = "DSN=pos"

adobeli.ConnectionString = KONEKSI
adobeli.CommandType = adCmdText
adobeli.RecordSource = "select * from beli"
adobeli.Refresh
adobeli.Recordset.Sort = "faktur"
adoviewbeliperiodik.ConnectionString = KONEKSI
adoviewbeliperiodik.CommandType = adCmdText
adoviewbeliperiodik.RecordSource = "select * from view_beli_periodik"
adoviewbeliperiodik.Refresh
adoviewbeliperiodik.Recordset.Sort = "faktur"

XTANGGAL = ""
Do While Not adobeli.Recordset.EOF
If adobeli.Recordset!tanggalbeli <> XTANGGAL Then
    txtmulai.AddItem Format(adobeli.Recordset!tanggalbeli, "DD-MM-YYYY")
    txtsampai.AddItem Format(adobeli.Recordset!tanggalbeli, "DD-MM-YYYY")
End If
XTANGGAL = adobeli.Recordset!tanggalbeli
adobeli.Recordset.MoveNext
Loop
txtmulai.Text = ""
txtsampai.Text = ""

End Sub
TOMBOL CETAK
Private Sub CMDCETAK_Click()

MULAI = Year(txtmulai.Text) & "," & Month(txtmulai.Text) & "," & Day(txtmulai.Text)
AKHIR = Year(txtsampai.Text) & "," & Month(txtsampai.Text) & "," & Day(txtsampai.Text)
CR.SelectionFormula = "{view_beli_periodik.tanggalbeli}>=DATE(" & MULAI & ") And {view_beli_periodik.tanggalbeli}<=DATE(" & AKHIR & ")"
CR.ReportFileName = App.Path & "/Laporan/Laporan Pembelian Periodik.rpt"
CR.WindowState = crptMaximized
CR.RetrieveDataFiles
CR.PrintReport
End Sub


Automatic Nomor Faktur Baru


MEMBUAT NOMOR FAKTUR BERDASARKAN URUTAN TGL ( 01/12/2012/001)
Private Sub Auto()
  Dim tgl As String
  tgl = CStr(Date)
  Dim Urutan As String * 14
  Dim Hitung As Byte
  With adojual.Recordset
  'If .RecordCount = 0 Then
  If .BOF Then
      Urutan = tgl & "/" & "001"
  Else
     .MoveLast
    Hitung = Val(Right(!nota, 3)) + 1
    Urutan = tgl & "/" & Right("0000" & Hitung, 3)
  End If
  global_nota = Urutan
  End With
End Sub


MEMBUAT NOMOR FAKTUR BERDASARKAN URUTAN  NOMOR ( P001)


Private Sub Auto()
  Dim Urutan As String * 4
  Dim Hitung As Byte
  With adopegawai.Recordset
  If .BOF Then
      Urutan = "P" & "001"
  Else
     .MoveLast
    Hitung = Val(Right(!idpegawai, 3)) + 1
    Urutan = "P" & Right("0000" & Hitung, 3)
  End If
    txtId.Text = Urutan
   End With
End Sub

Isi ComboBox dari Tabel


ISI COMBO BOX
Private Sub Form_Activate()
adobarang.clear
If Not adobarang.Recordset.BOF Then
    adobarang.Recordset.MoveFirst
    Do While Not adobarang.Recordset.EOF
        txtkodebarang.AddItem adobarang.Recordset!kodebarang
        adobarang.Recordset.MoveNext
    Loop
End If
End Sub
PENCARIAN DATA
Private Sub txtkodebarang_Click()
adobarang.Recordset.MoveFirst
adobarang.Recordset.Find "[kodebarang]= '" & txtkodebarang.Text & "'"
If Not adobarang.Recordset.EOF Then
    txtnamabarang.Text = adobarang.Recordset!namabarang
    txthargajual.Text = adobarang.Recordset!hargajual
    txtstok.Text = adobarang.Recordset!jumlahstok
    lblsatuan.Caption = adobarang.Recordset!satuan
End If
txtjumlahjual.SetFocus
End Sub

Koneksi Visual Basic 6 Dengan Database MySQL


Private Sub Form_Load()
adofingerprint_t.ConnectionString = "DSN=ksoft"
adofingerprint_t.CommandType = adCmdText
adofingerprint_t.RecordSource = "select * from Fingerprint_T"
adofingerprint_t.Refresh

Filtering Data


FILTER DATAGRID
Private Sub txtcari_Change()
If txtcari.Text <> "" Then
        adobarang.Recordset.Filter = "kode_barang like '*" & txtcari.Text & "*'"
    Else
  adobarang.Refresh
End If
End Sub

FILTER BERDASARKAN TANGGAL MULAI DAN TANGGAL AKHIR

Private Sub cmdfilter_Click()
adoabsensi.RecordSource = "select * from absensi where day(tanggal)>= " & Day(CDate(TXTMULAI.Value)) & " and day(tanggal)<= " & Day(CDate(TXTSAMPAI.Value)) & " and Month(tanggal)>= " & Month(CDate(TXTMULAI.Value)) & " And Month(tanggal)<= " & Month(CDate(TXTSAMPAI.Value)) & " and Year(tanggal)>=" & Year(CDate(TXTMULAI.Value)) & " and Year(tanggal)<=" & Year(CDate(TXTSAMPAI.Value)) & " AND idpegawai='" & adopegawai.Recordset!idpegawai & "'"
adoabsensi.Refresh
End Sub


Perintah SQL di Visual Basic 6

Dim db_barang As ADODB.Connection
Dim KONEKSI As String

Private Sub Form_Load()
KONEKSI = "DSN=pos" (untuk mysql)
KONEKSI = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=f:\database\stok.mdb" (untuk Microsoft Access)
Set db_barang = New ADODB.Connection
adobarang.ConnectionString = KONEKSI
adobarang.CommandType = adCmdText
adobarang.RecordSource = "select * from barang"
adobarang.Refresh
adobarang.Recordset.Sort = "kodebarang"
End Sub

PERINTAH INSERT
Private Sub insert_masuk()
SQL = "INSERT INTO barang_masuk(Faktur,tanggal,nobin,namamaterial,satuan,jumlah,jumlahmasuk) SELECT barang_masuk_semu.Faktur,barang_masuk_semu.tanggal,barang_masuk_semu.nobin, barang_masuk_semu.namamaterial, barang_masuk_semu.satuan, barang_masuk_semu.jumlah, barang_masuk_semu.jumlahmasuk FROM barang_masuk_semu where barang_masuk_semu.faktur='" & txtfaktur.Text & "'"
dbmasuk.Open KONEKSI
dbmasuk.Execute SQL
dbmasuk.Close
adomasuk.Refresh
End Sub

Private Sub add_insert()
SQL = "INSERT INTO jual_semu values ('" & global_nota & "','" & txtkodebarang.Text & "'," & txtjumlahjual.Text & ",'" & pengguna & "')"
DBjualSEMU.Open KONEKSI
DBjualSEMU.Execute SQL
DBjualSEMU.Close
adojualsemu.Refresh
End Sub


SQL = "INSERT INTO supplier values ('" & txtkodesupplier.Text & "','" & txtnamasupplier.Text & "', '" & txtalamat.Text & "','" & txtkota.Text & "', '" & txtnomorhp.Text & "','" & txtketerangan.Text & "')"
DBsupplier.Open KONEKSI
DBsupplier.Execute SQL
DBsupplier.Close
adosupplier.Refresh


Private Sub insert_tabel_jual()
Dim XTANGGAL As String
XTANGGAL = Format(Date, "YYYY/MM/DD")
Dim var_grandtotal As Double
var_grandtotal = CDbl(txttotal.Text) - CDbl(txtpotongan.Text)
SQL = "INSERT INTO jual values ('" & global_nota & "','" & XTANGGAL & "', '" & txtkodecustomer.Text & "'," & txttotal.Text & ", " & txtpotongan.Text & "," & var_grandtotal & ",'" & pengguna & "')"
DBjual.Open KONEKSI
DBjual.Execute SQL
DBjual.Close
adojual.Refresh
End Sub


PERINTAH UPDATE
Private Sub add_update()
SQL = "update jual_semu set " & "jumlahjual=jumlahjual + " & txtjumlahjual.Text & " where kodebarang='" & txtkodebarang.Text & "' and kodeuser='" & pengguna & "'"
DBjualSEMU.Open KONEKSI
DBjualSEMU.Execute SQL
DBjualSEMU.Close
adojualsemu.Refresh
End Sub

Private Sub update_stok_barang()
SQL = "UPDATE barang INNER JOIN TMPkeluar2 ON barang.kode_barang = TMPkeluar2.kode_barang SET jumlah = jumlah-TMPkeluar2.jumlah_keluar where TMPkeluar2.nomor_sj='" & txtnomorsj.Text & "'"
dbbarang.Open KONEKSI
dbbarang.Execute SQL
dbbarang.Close
adobarang.Refresh
End Sub

PERINTAH SELECT
Private Sub cari_total()
If adojualsemu.Recordset.RecordCount = 0 Then Exit Sub
SQL = "select sum(subtotal) as tot from view_jual where nota='" & global_nota & "' and kodeuser= '" & pengguna & "'"
dbview_jual.Open KONEKSI
Set rs = dbview_jual.Execute(SQL)
txttotal.Text = rs!tot
dbview_jual.Close
End Sub

PERINTAH DELETE
Private Sub hapus_data()
If adojualsemu.Recordset.RecordCount = 0 Then Exit Sub
SQL = "delete from jual_semu where kodeuser='" & pengguna & "'"
DBjualSEMU.Open KONEKSI
DBjualSEMU.Execute SQL
DBjualSEMU.Close
adojualsemu.Refresh
End Sub



Koneksi Visual Basic 6 Dengan Database Microsoft Access



Dim dbbarang As ADODB.Connection
Dim KONEKSI As String


Private Sub Form_Load()
Set dbbarang = New ADODB.Connection
KONEKSI = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=f:\database\stok.mdb"

adobarang.ConnectionString = KONEKSI
adobarang.RecordSource = "select * from Barang "
adobarang.Refresh

adohistori.ConnectionString = KONEKSI
adohistori.RecordSource = "select * from masuk  histori  day(tanggal)= " & Day(Date) & " and month(tanggal)=" & Month(Date) & " and Year(tanggal)=" & Year(Date) & ""
adohistori.Refresh
adohistori.Refresh