Rabu, 08 Januari 2014

Re: [belajar-access] Progress Bar

 

Hm.... memang ada perbedaan antara ms access 2003 dan 2010. Dan yang biasanya terjadi, aplikasi VBA buatan 2003 ketika dieksekusi di 2010 tidak bisa jalan.

Mungkin itu terjadi karena import form 2003. Coba di compact  & repair. Atau:

1. buatlah form baru dilakukan di Access 2010.
2. Buka yang 2003 ==> design form ==> select all ==> copy
3. Pastekan di 2010
4. Buka code VBA 2003 == select all ==> copy
5. Buka code VBA 2010 == select all ==> delete ==> pastekan yang dari 2003 ==> save
6. Design 2010 ==> lihat event on click command8 (biasanya tidak tampak) ==> chose builder ==> pilih code builder ==> Akan menuju ke VBA hasil copy paste dari 2003 ==> Save
7. Coba eksekusi.

Mungkin bisa pula menempuh ini:

Saat awal buka, muncul set warning == klik button option yang ada sebelahnya. ==> pilih accept all contain

Semoga bisa membantu dan memberi semangat.


Hariyanto (Surabaya)






On Wednesday, 8 January 2014, 14:18, cepwahyu <cepwahyu@gmail.com> wrote:
 
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
CW
 
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
CW
 
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)
 
On Tuesday, 7 January 2014, 22:49, "tasurun@gmail.com" <tasurun@gmail.com> wrote:
 
Terima Kasih bro Hariyanto untuk respon dan file attachmentnya
sangat bermanfaat,
yang saya tanyakan, bisakah tanpa kita ketikkan atau input, access bisa otomatis mencari dari field / kolom yang sama atau mirip?
maaf kalau merepotkan
 
 
 
 


__._,_.___
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (41)
Recent Activity:
SPAM IS PROHIBITED
.

__,_._,___

Tidak ada komentar:

Posting Komentar