[Programmer-VB] Jawaban bwat Ferry_xls

Gege Nugroho Thu, 06 Jul 2006 21:50:23 -0700

Maap gwe tjoba djawab, tapi dicoba dulu ye
1. Di Tabel Master Barang harus ada field
"Nama_Brg,Kode_Brg,SaldoAwal1,...SaldoAwal12"
2. Di DtTemp harus ada field
"Nama_Brg,Kode_Brg,SaldoAwal,In,Out,Remark,SaldoAkhir"

Dim nSldAwl As Double
Private Sub Post()
    DtTemp.Refresh

    Set cnM = New ADODB.Connection
    Set rsM = New ADODB.Recordset
    xM = "Select * From M_Brg Where KodeBrg='" & cKode.Text & "'"

    cnM.Open "C"\Database\Master.mdb"
    cnM.CursorLocation = adUseClient
    rsM.CursorLocation = adUseClient
    rsM.Open xM, cnM, adOpenKeyset, adLockOptimistic
    If Not rsM.EOF Then
        Do While rsM.Fields("KodeBrg") = cKode.Text And rsM.EOF = False
            If Month(dTglAwal.Value) = 1 Then
                nSldAwl = rsM.Fields("SaldoAwal1")
            ElseIf Month(dTglAwal.Value) = 2 Then
                nSldAwl = rsM.Fields("SaldoAwal2")
            ElseIf Month(dTglAwal.Value) = 3 Then
                nSldAwl = rsM.Fields("SaldoAwal3")
            ElseIf Month(dTglAwal.Value) = 4 Then
                nSldAwl = rsM.Fields("SaldoAwal4")
            ElseIf Month(dTglAwal.Value) = 5 Then
                nSldAwl = rsM.Fields("SaldoAwal5")
            ElseIf Month(dTglAwal.Value) = 6 Then
                nSldAwl = rsM.Fields("SaldoAwal6")
            ElseIf Month(dTglAwal.Value) = 7 Then
                nSldAwl = rsM.Fields("SaldoAwal7")
            ElseIf Month(dTglAwal.Value) = 8 Then
                nSldAwl = rsM.Fields("SaldoAwal8")
            ElseIf Month(dTglAwal.Value) = 9 Then
                nSldAwl = rsM.Fields("SaldoAwal9")
            ElseIf Month(dTglAwal.Value) = 10 Then
                nSldAwl = rsM.Fields("SaldoAwal10")
            ElseIf Month(dTglAwal.Value) = 11 Then
                nSldAwl = rsM.Fields("SaldoAwal11")
            Else
                nSldAwl = rsM.Fields("SaldoAwal12")
            End If
            If nSldAwl <> 0 Then
                DtTemp.Recordset.AddNew
                DtTemp.Recordset!Remark = "Saldo Awal"
                DtTemp.Recordset!Kode_Brg = cKode.Text
                DtTemp.Recordset!In = nSldAwl
                DtTemp.Recordset!User = cUserId
                DtTemp.Recordset.Update
            End If
            rsM.MoveNext
            If rsM.EOF Then
                Exit Do
            End If
        Loop
    End If
    DtTemp.Refresh
    rsM.Close
    cnM.Close
    Set cnM = Nothing
    Set rsM = Nothing

    AmbilData
End Sub
Private Sub AmbilData()
    'Ambil Data dari Tabel barang Masuk
    Set cnT = New ADODB.Connection
    Set rsT = New ADODB.Recordset

    xT = "Select * From T_BarangMasuk Where Kode_Brg='" & cKode.Text &
"'"
      cnT.Open "C:\Database\Transaksi.mdb"
    cnT.CursorLocation = adUseClient
    rsT.CursorLocation = adUseClient
    rsT.Open xT, cnT, adOpenKeyset, adLockOptimistic
    prbProses.Limit = rsT.RecordCount - 1
    With rsT
        If Not .EOF Then
            Do While !Kode_Brg = cKode.Text
                If CDate(!Tgl_MSK) >= dTglAwal.Value And
CDate(!Tgl_MSK) <= dTglAkhir.Value Then
                        DtTemp.Recordset.AddNew
                        DtTemp.Recordset!NoTrans = !No_MSK
                        DtTemp.Recordset!TglTrans = !Tgl_MSK
                        DtTemp.Recordset!Kode_Brg = cKode.Text
                        DtTemp.Recordset!Remark = "Penerimaan Barang"
                        DtTemp.Recordset!In = !Qty_MSK
                        DtTemp.Recordset.Update
                End If
                .MoveNext
                If .EOF Then
                    Exit Do
                End If
            Loop
        End If
    End With
    rsT.Close
      'Ambil data dari tabel barang Keluar
    Set rsT = New ADODB.Recordset
    xT = "Select * From T_BarangKeluar Where Kode_Brg='" & cKode.Text &
"'"
    rsT.CursorLocation = adUseClient
    rsT.Open xT, cnT, adOpenKeyset, adLockOptimistic
    With rsT
        If Not .EOF Then
            Do While !Kode_Brg = cKode.Text
                If CDate(!Tgl_KLR) >= dTglAwal.Value And
CDate(!Tgl_KLR) <= dTglAkhir.Value Then
                        DtTemp.Recordset.AddNew
                        DtTemp.Recordset!NoTrans = !No_KLR
                        DtTemp.Recordset!TglTrans = !Tgl_KLR
                        DtTemp.Recordset!Kode_Brg = cKode.Text
                        DtTemp.Recordset!Remark = "Pengeluaran Barang"
                        DtTemp.Recordset!Out = !Qty_KLR
                        DtTemp.Recordset.Update
                    End If
                End If
                .MoveNext
                If .EOF Then
                    Exit Do
                End If
            Loop
        End If
    End With
    rsT.Close
    Set cnT = Nothing
    Set rsT = Nothing
    DtTemp.Refresh
End Sub

Met nyoba n sukses

Regards
Gege Nugroho

Do you Yahoo!?
Next-gen email? Have it all with the all-new Yahoo! Mail Beta. __._,_.___

Wahana Programmer Groups Links <*> Untuk mengunjungi sponsor milis ini, klik link berikut: http://wahanaprogrammer.net <*> Untuk menghubungi owner milis ini, kirim email ke: [EMAIL PROTECTED] <*> Konsultasi pemrogramman bisa chat disini: Yahoo! Messenger: wahanaprogrammer

SPONSORED LINKS

`Programmer`	`Indonesia`	`Basic programming language`
`Computer programming languages`	`Programming languages`	`Java programming language`

YAHOO! GROUPS LINKS

Visit your group "Programmer-VB" on the web.
To unsubscribe from this group, send an email to: [EMAIL PROTECTED]
Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.

__,_._,___

[Programmer-VB] Jawaban bwat Ferry_xls

Kirim email ke