ACCESS FEED: RE: [belajar-access] Progress Bar

Selasa, 07 Januari 2014

RE: [belajar-access] Progress Bar

Mas Hariyanto,

Saya coba import form-nya yg mas haryanto kasih ke database yg saya buat (saya pake access 2010), kemudian saya modif sq-nya sbb:

Option Compare Database

Option Explicit

Private Sub Command8_Click()

Dim msg As Variant

If cek_que("QCloneNameTempTbl") Then

pro_que ("QCloneNameTempTbl")

Else

msg = "QCloneNameTempTbl"

End If

If cek_que("QMediaIncomingTempTbl") Then

pro_que ("QMediaIncomingTempTbl")

Else

msg = "QMediaIncomingTempTbl"

End If

If cek_que("QMediaProductionTempTbl") Then

pro_que ("QMediaProductionTempTbl")

Else

msg = "QMediaProductionTempTbl"

End If

If cek_que("QMediaDeliveryTempTbl") Then

pro_que ("QMediaDeliveryTempTbl")

Else

msg = "QMediaDeliveryTempTbl"

End If

If cek_que("QMediaWastageTempTbl") Then

pro_que ("QMediaWastageTempTbl")

Else

msg = "QMediaWastageTempTbl"

End If

If cek_que("QCultureIncomTempTbl") Then

pro_que ("QCultureIncomTempTbl")

Else

msg = "QCultureIncomTempTbl"

End If

If cek_que("QCultureProductionTempTbl") Then

pro_que ("QCultureProductionTempTbl")

Else

msg = "QCultureProductionTempTbl"

End If

If cek_que("QCultureDeliveryTempTbl") Then

pro_que ("QCultureDeliveryTempTbl")

Else

msg = "QCultureDeliveryTempTbl"

End If

If cek_que("QCultureWastageTempTbl") Then

pro_que ("QCultureWastageTempTbl")

Else

msg = "QCultureWastageTempTbl"

End If

End Sub

Function pro_que(sq)

Dim i As Double

Dim ReturnValue As Variant

Dim maxvalue As Double

Dim stepp As Double

Dim X As Variant

Dim Total, t As Double

Label10.Visible = False

maxvalue = 100

stepp = 100 / maxvalue

ReturnValue = SysCmd(SYSCMD_INITMETER, "Building query", 100)

Status.Visible = True

Box2.Visible = True

Box1.Visible = True

Label9.Visible = True

t = 1

For i = 1 To maxvalue

Total = Total + stepp

X = Int(Total)

ReturnValue = SysCmd(SYSCMD_UPDATEMETER, X)

Status.Caption = "Sedang memproses query " & sq

Box2.Width = (t / Total) * 5000

Label9.Caption = i & "%"

DoEvents

t = t + 1

Next i

DoCmd.OpenQuery (sq)

ReturnValue = SysCmd(SYSCMD_SETSTATUS, "Updating query")

ReturnValue = SysCmd(SYSCMD_REMOVEMETER)

Label10.Caption = Label10.Caption _

& "Sukses memproses query " & sq & vbCrLf

Status.Visible = False

Box2.Visible = False

Box1.Visible = False

Label9.Visible = False

Label10.Visible = True

End Function

Function cek_que(sq) As Boolean

Dim hasil As Boolean

Dim rbs As Recordset

Set rbs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name" _

& " FROM MSysObjects WHERE MSysObjects.Type=5 And MSysObjects.Flags=0" _

& " and MSysObjects.Name='" & sq & "'") 'melihat nama tabel query

If Not rbs.EOF Then 'bila ada record

hasil = True

Else

hasil = False

End If

'menghilangkan dari memory komputer

rbs.Close

Set rbs = Nothing

cek_que = hasil

End Function

Kenapa tidak ada reaksi apa-apa ya mas? Alias tidak jalan progress barnya dan tidak ada keterangan error juga.

Sebagai tambahan keterangan, query yg saya jalankan ini adalah Make Table Query.

Best Regards

From: belajar-access@yahoogroups.com [mailto:belajar-access@yahoogroups.com] On Behalf Of hari yanto
Sent: 08 Januari 2014 12:44
To: belajar-access@yahoogroups.com
Subject: Re: [belajar-access] Progress Bar [1 Attachment]

[Attachment(s) from hari yanto included below]

CepWahyu...,

Untuk membuat progress bar customized dikaitkan dengan proses membuka query, dapat memanfaatkan SysCmd bawaan dari Ms Access.
Nilai-nilai dari sana kita rupakan dalam bentuk progress bar.

Dalam bahasa VBA, updaya tersebut bisa kita rupakan seperti ini (sq adalah nama quey yang akan dibuka):

Function pro_que(sq)
Dim i As Double
Dim ReturnValue As Variant
Dim maxvalue As Double
Dim stepp As Double
Dim X As Variant
Dim Total, t As Double

    Label10.Visible = False
    maxvalue = 100
    stepp = 100 / maxvalue

    ReturnValue = SysCmd(SYSCMD_INITMETER, "Building query", 100)

    Status.Visible = True
    Box2.Visible = True
    Box1.Visible = True
    Label9.Visible = True
    t = 1
    For i = 1 To maxvalue
            Total = Total + stepp
            X = Int(Total)
            ReturnValue = SysCmd(SYSCMD_UPDATEMETER, X)
            Status.Caption = "Sedang memproses query " & sq
            Box2.Width = (t / Total) * 5000
            Label9.Caption = i & "%"
            DoEvents
            t = t + 1
        Next i

        DoCmd.OpenQuery (sq)

    ReturnValue = SysCmd(SYSCMD_SETSTATUS, "Updating query")
    ReturnValue = SysCmd(SYSCMD_REMOVEMETER)

    Label10.Caption = Label10.Caption _
    & "Sukses memproses query " & sq & vbCrLf

    Status.Visible = False
    Box2.Visible = False
    Box1.Visible = False
    Label9.Visible = False
    Label10.Visible = True
End Function

Terlampir adalah contoh mdb 2003 yang merupakan perwujudan dari progress bar untuk membuka query.

Semoga bisa membantu dan memberi semangat.

Hariyanto (Surabaya)

On Wednesday, 8 January 2014, 8:23, cepwahyu <cepwahyu@gmail.com> wrote:

Mas Hariyanto,

Ikut nimbrung nih, sy mau tanya tentang progress bar. Saya sudah baca2 di web-nya mas Hariyanto (LPJK Jatim) tentang buat progress bar-nya. Pertanyaan saya gimana caranya supaya progrees bar itu menggambarkan proses yg sedang berlangsung?

Proses berikut yang saya ingin kaitkan dengan progress bar:

Private Sub CmdRefresh_Click()

DoCmd.SetWarnings False

DoCmd.OpenQuery "QCloneNameTempTbl"

DoCmd.OpenQuery "QMediaIncomingTempTbl"

DoCmd.OpenQuery "QMediaProductionTempTbl"

DoCmd.OpenQuery "QMediaDeliveryTempTbl"

DoCmd.OpenQuery "QMediaWastageTempTbl"

DoCmd.OpenQuery "QCultureIncomTempTbl"

DoCmd.OpenQuery "QCultureProductionTempTbl"

DoCmd.OpenQuery "QCultureDeliveryTempTbl"

DoCmd.OpenQuery "QCultureWastageTempTbl"

DoCmd.SetWarnings True

MsgBox "Done!", vbOKOnly, "Refresh"

End Sub

VBA ini sudah berjalan cuman tidak ada progress bar-nya.

Best Regards

From: belajar-access@yahoogroups.com [mailto:belajar-access@yahoogroups.com] On Behalf Of hari yanto
Sent: 08 Januari 2014 0:30
To: belajar-access@yahoogroups.com
Subject: Re: [belajar-access] Mencari Data yang Mirip [1 Attachment]

[Attachment(s) from hari yanto included below]

Tasurun....,

Harapan Sampeyan bisa dijalankan. Yang harus dilakukan sudah barang tentu harus mengubah tabel dan script VBA.

Untuk tabel, perlu ditambah 1 field yang berisi keterangan kata alamat sama. Misal, kita tambah field bernama ket. Type text. Panjang 255.

Sedangkan script, yang harus diubah adalah variabel kontrolnya. Bila semula berada di tangan user, ganti dengan record mulai pertama sampai terakhir.

Lalu, dibandingkan dengan dengan record-record lain dengan catatan nama sama persis. Apabila dari proses tersebut berisi data mirip, update field ket pada tabel dengan data mirip itu.

Agar tampak menarik, beri progress bar saat proses sedang berlangsung. Dan bila sudah selesai, matikan progress bar. Serta sampaikan hasilnya ke user.

Terlampir, adalah revisi file mdb 2003 yang merangkup uraian diatas.

Semoga bisa membantu dan memberi semangat.

Hariyanto (Surabaya)