Dear All.
User mau nambah report "Data Mutasi", sehingga saya harus bikin table baru
dengan data ditarik dari table-table yang sudah berjalan. Untuk itu saya bikin
program kecil (hanya sekali jalan) tetapi nantinya table baru tersebut akan disi
dari setiap transaksi. Proses berjalan baik cuma transfer datanya lama minta
ampun 1 hari 1 malam. saya kasih kodingnya, ada masukan untuk mempercepat
proses? (pada proses Stock Awal cuma 2 menit, pada proses transaksi 1 hari 1
malam).
Option Explicit
Private Sub cmdOK_Click()
If MsgBox("Yakin transfer data ke table mutasi?", vbQuestion + vbYesNo,
"Transfer Data") = vbNo Then Exit Sub
MousePointer = vbHourglass
StockAwal
TransferData
MousePointer = vbDefault
MsgBox "Transfer data selesai.", vbInformation, "Transfer Data"
End Sub
Private Sub StockAwal()
Dim table1 As ADODB.Recordset
Dim table2 As ADODB.Recordset
Dim sql As String
Dim L As Long
Dim dAwal, dAkhir As Double
Set table1 = New ADODB.Recordset
sql = "select a. kode_counter,a.ukuran,a.qty, b.* from master_qty a " & _
"left join barang b on a.kode_barang = b.kode order by b.kode"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If table1.RecordCount > 0 Then
table1.MoveFirst
Else
Set table1 = Nothing
Exit Sub
End If
ProgressBar1.Min = 0
ProgressBar1.Max = table1.RecordCount
For L = 1 To table1.RecordCount
Set table2 = New ADODB.Recordset
sql = "select * from historical where kode_barang ='" & table1!kode & "' " &
_
"and kode_ke_counter='" & table1!kode_counter & "' and
tanggal_transaksi='20080727' " & _
"and alasan='STOCK AWAL'"
table2.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If table2.RecordCount = 0 Then
dAwal = 0
dAkhir = 0
Else
dAwal = table2!qty_edit
dAkhir = table2!qty_edit
End If
sql = "insert into mutasi
(tanggal_mutasi,kode_barang,jenis_barang,nama_barang, " & _
"kode_counter,awal,akhir) values " & _
"('20080727','" & table1!kode & "','" & table1!jenis & "','" &
table1!nama & "','" & table1!kode_counter & "'," & dAwal & "," & dAkhir & ")"
MdbConnection.Execute sql
table1.MoveNext
ProgressBar1.Value = L
Next
Set table2 = Nothing
Set table1 = Nothing
End Sub
Private Sub TransferData()
Dim table1 As ADODB.Recordset
Dim table2 As ADODB.Recordset
Dim sql As String
Dim L As Long
Dim M As Long
Dim lTanggal As Long
Dim sTanggalMutasi As String
Dim sTanggalAmbil As String
Dim dJumlah As Double
Dim dAwal, dBeli, dReturBeli, dGudangMasuk, dGudangKeluar, dEditTambah,
dEditKurang, dJual, dReturJual, dAkhir As Double
lTanggal = DateDiff("d", "07/27/2008", Now)
sTanggalMutasi = "07/27/2008"
'******Tanggal yang diambil mulai dari tanggal 27 Agustus 2008 s/d
sekarang******
ProgressBar2.Min = 0
ProgressBar2.Max = lTanggal
For M = 1 To lTanggal
Set table1 = New ADODB.Recordset
sql = "select a. kode_counter,a.ukuran,a.qty, b.* from master_qty a " & _
"left join barang b on a.kode_barang = b.kode order by b.kode"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
'*******Data yang dimabil disini sekitar 1900 record*******
If table1.RecordCount > 0 Then
table1.MoveFirst
Else
Set table1 = Nothing
Exit Sub
End If
ProgressBar1.Min = 0
ProgressBar1.Max = table1.RecordCount
For L = 1 To table1.RecordCount
sTanggalAmbil = DateAdd("d", 1, sTanggalMutasi)
sTanggalAmbil = Format(sTanggalAmbil, "MM/dd/yyyy")
sTanggalAmbil = FormatTanggalTable(sTanggalAmbil)
sTanggalMutasi = FormatTanggalTable(sTanggalMutasi)
dAwal = Awal(table1!kode, table1!kode_counter, sTanggalMutasi)
dBeli = Beli(table1!kode, sTanggalAmbil)
dReturBeli = ReturBeli(table1!kode, sTanggalAmbil)
dGudangMasuk = GudangMasuk(table1!kode, table1!kode_counter,
sTanggalAmbil)
dGudangKeluar = GudangKeluar(table1!kode, table1!kode_counter,
sTanggalAmbil)
dEditTambah = EditTambah(table1!kode, table1!kode_counter,
sTanggalAmbil)
dEditKurang = EditTambah(table1!kode, table1!kode_counter,
sTanggalAmbil)
dJual = EditTambah(table1!kode, table1!kode_counter, sTanggalAmbil)
dReturJual = EditTambah(table1!kode, table1!kode_counter, sTanggalAmbil)
dAkhir = dAwal + dBeli - dReturBeli + dGudangMasuk - dGudangKeluar +
dEditTambah - dEditKurang - dJual + dReturJual
dJumlah = dBeli + dReturBeli + dGudangMasuk + dGudangKeluar +
dEditTambah + dEditKurang + dJual + dReturJual
If dJumlah <> 0 Then
Set table2 = New ADODB.Recordset
sql = "select * from mutasi"
table2.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
table2.AddNew
table2!tanggal_mutasi = sTanggalAmbil
table2!kode_barang = table1!kode
table2!jenis_barang = table1!jenis
table2!nama_barang = table1!nama
table2!kode_counter = table1!kode_counter
table2!Awal = dAwal
table2!Beli = dBeli
table2!retur_beli = dReturBeli
table2!gudang_masuk = dGudangMasuk
table2!gudang_keluar = dGudangKeluar
table2!edit_tambah = dEditTambah
table2!edit_kurang = dEditKurang
table2!Jual = dJual
table2!retur_jual = dReturJual
table2!Akhir = dAkhir
table2.Update
End If
sTanggalMutasi = FormatTanggal(sTanggalMutasi)
table1.MoveNext
ProgressBar1.Value = L
Next L
sTanggalMutasi = DateAdd("d", 1, sTanggalMutasi)
sTanggalMutasi = Format(sTanggalMutasi, "MM/dd/yyyy")
ProgressBar2.Value = M
Next M
Set table1 = Nothing
Set table2 = Nothing
End Sub
Function FormatTanggal(tanggal As String) As String
Dim sTgl As String
Dim sBln As String
Dim sThn As String
If Len(tanggal) = 0 Then
FormatTanggal = "-"
Exit Function
End If
sTgl = Right(tanggal, 2)
sBln = Mid(tanggal, 5, 2)
sThn = Left(tanggal, 4)
FormatTanggal = sBln & "/" & sTgl & "/" & sThn
End Function
Function FormatTanggalTable(tanggal As String) As String
Dim sTgl As String
Dim sBln As String
Dim sThn As String
If Len(tanggal) = 0 Then
FormatTanggalTable = "-"
Exit Function
End If
sTgl = Mid(tanggal, 4, 2)
sBln = Left(tanggal, 2)
sThn = Right(tanggal, 4)
FormatTanggalTable = sThn & sBln & sTgl
End Function
Function Awal(barang As String, counter As String, tanggal As String) As Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select * from mutasi where kode_barang ='" & barang & "' " & _
"and kode_counter='" & counter & "' and tanggal_mutasi<='" & tanggal & "'
order by tanggal_mutasi desc"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If table1.RecordCount = 0 Then
Awal = 0
Set table1 = Nothing
Exit Function
End If
table1.MoveFirst
Awal = table1!Akhir
Set table1 = Nothing
End Function
Function Beli(barang As String, tanggal As String) As Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from pembelian where kode_barang ='" & barang & "'
" & _
"and tanggal_beli='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
Beli = 0
Set table1 = Nothing
Exit Function
End If
Beli = table1!qty
Set table1 = Nothing
End Function
Function ReturBeli(barang As String, tanggal As String) As Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from retur_pembelian where kode_barang ='" &
barang & "' " & _
"and tanggal_retur='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
ReturBeli = 0
Set table1 = Nothing
Exit Function
End If
ReturBeli = table1!qty
Set table1 = Nothing
End Function
Function GudangMasuk(barang As String, counter As String, tanggal As String) As
Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from pindahgudang where kode_barang ='" & barang &
"' " & _
"and kode_counter2='" & counter & "' and tanggal_pindah='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
GudangMasuk = 0
Set table1 = Nothing
Exit Function
End If
GudangMasuk = table1!qty
Set table1 = Nothing
End Function
Function GudangKeluar(barang As String, counter As String, tanggal As String) As
Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from pindahgudang where kode_barang ='" & barang &
"' " & _
"and kode_counter1='" & counter & "' and tanggal_pindah='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
GudangKeluar = 0
Set table1 = Nothing
Exit Function
End If
GudangKeluar = table1!qty
Set table1 = Nothing
End Function
Function EditTambah(barang As String, counter As String, tanggal As String) As
Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from historical where kode_barang ='" & barang &
"' " & _
"and kode_ke_counter='" & counter & "' and tanggal_transaksi='" & tanggal &
"' and state1=5"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
EditTambah = 0
Set table1 = Nothing
Exit Function
End If
EditTambah = table1!qty
Set table1 = Nothing
End Function
Function EditKurang(barang As String, counter As String, tanggal As String) As
Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from historical where kode_barang ='" & barang &
"' " & _
"and kode_ke_counter='" & counter & "' and tanggal_transaksi='" & tanggal &
"' and state1=4"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
EditKurang = 0
Set table1 = Nothing
Exit Function
End If
EditKurang = table1!qty
Set table1 = Nothing
End Function
Function Jual(barang As String, counter As String, tanggal As String) As Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from penjualan where kode_barang ='" & barang & "'
" & _
"and kode_counter='" & counter & "' and tanggal_jual='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
Jual = 0
Set table1 = Nothing
Exit Function
End If
Jual = table1!qty
Set table1 = Nothing
End Function
Function ReturJual(barang As String, counter As String, tanggal As String) As
Double
Dim table1 As ADODB.Recordset
Dim sql As String
Set table1 = New ADODB.Recordset
sql = "select sum(qty) as qty from penjualan where kode_barang ='" & barang & "'
" & _
"and kode_counter='" & counter & "' and tanggal_jual='" & tanggal & "'"
table1.Open sql, MdbConnection, adOpenDynamic, adLockOptimistic
If IsNull(table1!qty) = True Then
ReturJual = 0
Set table1 = Nothing
Exit Function
End If
ReturJual = table1!qty
Set table1 = Nothing
End Function
Private Sub cmdExit_Click()
If MsgBox("Yakin mau ke luar?", vbQuestion + vbYesNo, "Update Tanggal") = vbYes
Then
Set MdbConnection = Nothing
End
End If
End Sub
