Benar... Dalam kasus sampeyan, sepertinya perlu dibuat tabel temporer 2 buah. Teknisnya begini (kasus ini hanya membuat dan mengisi satu tabel): 1. kita definisikan dulu nama komputer yang akan mengakses. Saya pakai fungsi berikut (saya taruh di modul, karena saya gunakan dibanyak form): Option Explicit '*********** Code Start ************ ' This code was originally written by Terry Kreft. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Terry Kreft ' Public Const IDC_APPSTARTING = 32650& Public Const IDC_HAND = 32649& Public Const IDC_ARROW = 32512& Public Const IDC_CROSS = 32515& Public Const IDC_IBEAM = 32513& Public Const IDC_ICON = 32641& Public Const IDC_NO = 32648& Public Const IDC_SIZE = 32640& Public Const IDC_SIZEALL = 32646& Public Const IDC_SIZENESW = 32643& Public Const IDC_SIZENS = 32645& Public Const IDC_SIZENWSE = 32642& Public Const IDC_SIZEWE = 32644& Public Const IDC_UPARROW = 32516& Public Const IDC_WAIT = 32514& Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _ (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long Declare Function LoadCursorFromFile Lib "user32" Alias _ "LoadCursorFromFileA" (ByVal lpFileName As String) As Long Declare Function SetCursor Lib "user32" _ (ByVal hCursor As Long) As Long Private Const MAX_COMPUTERNAME As Long = 15 Private Declare Function GetComputerName Lib "kernel32" _ Alias "GetComputerNameA" _ (ByVal lpBuffer As String, _ nSize As Long) As Long Private Function TrimNull(item As String) 'return string before the terminating null Dim pos As Integer pos = InStr(item, Chr$(0)) If pos Then TrimNull = Left$(item, pos - 1) Else TrimNull = item End If End Function Function KOM() Dim tas As String 'pre-load the text boxes with 'the local computer name for testing tas = Space$(MAX_COMPUTERNAME + 1) Call GetComputerName(tas, Len(tas)) KOM = TrimNull(tas) If KOM Like "*-*" Then KOM = Replace(KOM, "-", "_") End If End Function 'fungsi ini untuk menyederhanakan panggilan Function AMBIL_SBU() AMBIL_SBU = "BU_PENGAMBIL_" & KOM End Function 2. Form dan subform yang akan ditampilkan tidak ada recordsourcenya. Misalnya, Form utama berisi text box dengan nama dAmb. Terus ada sub formnya bernama BU_AMBIL_1, sourceobject-nya dikosongi. Buat juga form BU_AMBIL_1 (tanpa recordsource), untuk nanti diletakkan pada subform utama. 3. Maka, kalau form utama dibuka, akan kosong dan ringan. Sekarang, kita bayangkan user sedang memasukkan nilai pada text box dAmb. Terus dia menekan enter dan berharap mengeluarkan data sesuai permintaanya. Untuk sesuai harapan user, kita beri event after update pada text box dAmb. Sebelum masuk ke database, sebaiknya divalidasi dulu, apakah type data sesuai dengan type data database. Gampangnya seperti ini: If IsNumeric(dAmb) Then dAmb = Fix(dAmb) BU_AMBIL_1.Visible = False 'agar tidak tampil sementara BU_AMBIL_1.SourceObject = "" 'agar kita bisa mengisi data Lanjut Else MsgBox "MASUKKAN KARAKTER ANGKA. JANGAN HURUF ATAU KARAKTER LAINNYA" dAmb = "" dAmb.SetFocus End If 4. Sebelum masuk ke fungsi lanjut, saya buat query dengan isi sql sbb: SELECT MSysObjects.Name AS TABEL FROM MSysObjects WHERE (((MSysObjects.Type)=1) AND ((MSysObjects.Flags)=0)) ORDER BY MSysObjects.Name; 5. Buat fungsi dengan tujuan membuat/menghapus tabel kalau user melakukan aksi Function BUAT_TABEL() Dim db As DAO.Database Dim rbs As Recordset 'melihat ada tidaknya tabel leges user Set rbs = CurrentDb.OpenRecordset("SELECT TABEL FROM NAMA_TABEL" _ & " WHERE TABEL='" & AMBIL_SBU & "'") 'kalau ada tabel dihapus If Not rbs.EOF Then Set db = CurrentDb db.TableDefs.Delete AMBIL_SBU db.Close Set db = Nothing End If rbs.Close 'sekarang membuat tabel, sesuaikan field-field sesuai kebutuhan user. Tidak semua harus ditampilkan. DoCmd.RunSQL "CREATE TABLE " & AMBIL_SBU & " (ID_LEGES Number, BEDA Number," _ & " ID_BU Number, ID_BU_1 Number, NO_AMBIL Number, KLIEN Text(80)," _ & " TANGGAL Text(30), NRBU Text, NMBUJK Text(80), ID_SUBBID_BU Number," _ & " GRADE Number, KLIEN_AMBIL Text(80), BID Number," _ & " TANGGAL_AMBIL Text(30), AMBIL YesNo, FC YesNo);" KOKO 'fungsi koko untuk memperlihatkan YesNo seperti yang biasa kita lihat (menjadi check box). end function Function KOKO() Dim tdf As DAO.TableDef Dim fld As DAO.Field Dim db As Database Dim strSQL As String Dim prp As DAO.Property Set db = CurrentDb 'It is now in the table collection, so ... Set tdf = db.TableDefs(AMBIL_SBU) 'Change the way the YesNo fields display. 'A Checkbox Set fld = tdf.Fields("AMBIL") Set prp = fld.CreateProperty("DisplayControl", dbInteger, acCheckBox) fld.Properties.Append prp Set fld = tdf.Fields("FC") Set prp = fld.CreateProperty("DisplayControl", dbInteger, acCheckBox) fld.Properties.Append prp db.Close Set db = Nothing End Function 6. Sekarang masuk ke fungsi lanjut. Function lanjut() Dim st As Recordset Dim rsj, rsp As ADODB.Recordset BUAT_TABEL KONEKSI If conn.State <> 0 Then 'koneksi sukses, kita meminta/lihat data di database (contoh ini pakai MySql) Set rsp = New ADODB.Recordset rsp.Open "SELECT * FROM" _ & " BU_1 WHERE ID_LEGES=" & dAmb _ & " ORDER BY NRBU ASC, ID_SUBBID_BU ASC", conn If Not rsp.EOF Then 'kalau data ada, lakukan pengisian (data semua) ke tabel temporer Do While Not rsp.EOF Set st = CurrentDb.OpenRecordset(AMBIL_SBU) st.AddNew st!BEDA = Nz(DMax("[BEDA]", AMBIL_SBU, ""), 0) + 1 st!NO_AMBIL = rsp!bu_a st!id_bu_1 = rsp!id_bu_1 If IsNull(rsp!ID_LEGES) Then Else Set rsj = New ADODB.Recordset rsj.Open "SELECT * FROM" _ & " BU_LEGES WHERE ID_LEGES=" & rsp!ID_LEGES, conn If Not rsj.EOF Then st!KLIEN = rsj!KLIEN st!TANGGAL = rsj!TANGGAL End If rsj.Close Set rsj = Nothing End If st!NRBU = Format(rsp!NRBU, "000000") st!ID_LEGES = rsp!ID_LEGES Set rsj = New ADODB.Recordset rsj.Open "SELECT NMBUJK FROM" _ & " BU WHERE NRBU=" & rsp!NRBU, conn If Not rsj.EOF Then st!NMBUJK = rsj!NMBUJK End If rsj.Close Set rsj = Nothing st!ID_SUBBID_BU = rsp!ID_SUBBID_BU st!BID = Left(rsp!ID_SUBBID_BU, 2) st!GRADE = rsp!GRADE st!FC = rsp!FC If IsNull(rsp!bu_a) Then Else Set rsj = New ADODB.Recordset rsj.Open "SELECT * FROM" _ & " BU_AMBIL WHERE BU_A=" & rsp!bu_a, conn If Not rsj.EOF Then st!klien_ambil = rsj!klien_ambil st!TANGGAL_AMBIL = rsj!TANGGAL_AMBIL End If rsj.Close Set rsj = Nothing End If st.Update st.Close Set st = Nothing rsp.MoveNext Loop End If rsp.Close Set rsp = Nothing End If conn.Close Set conn = Nothing ' ini untuk memberi source object sub form BU_AMBIL_1, yang defaultnya kosong. 'proses ini tidak terlihat karena masih dalam posisi unvisible BU_AMBIL_1.SourceObject = "BU_AMBILEN_1" 'ini memberi recordsource utk subform. Sebelumnya nama-nama texbox sudah disesuaikan dengan tabel temporer BU_AMBIL_1.Form.RecordSource = AMBIL_SBU dAmb.SetFocus 'bila proses sudah selesai, sub form baru di visible kan BU_AMBIL_1.Visible = True End Function Terlalu panjang ya.....? Itulah yang harus kita lalui. Saya berpendapat, lebih baik bersakit-sakit dahulu. Kalau suatu saat nanti beralih ke bahasa pemrograman lain (PHP, dlsb), akan lebih mudah. Karena prinsip yang digunakan sama. Ada saatnya kita menggunakan Ms Acces, ada saat pula kita memakai yang lainnya.. (kalau kita ingin maju terus). Saya sendiri bisa sedikit PHP, ya dari upaya memahami liku-liku VBA dan VB. Tanpa VBA dan Ms Acces, saya tidak mungkin bisa PHP. Karena dari sanalah saya bermula. (Hasil kombinasi Ms Acces, VBA, PHP, HTML, dan sedikit Java, bisa dilihat di ini: http://110.139.57.19/) Semoga bisa membantu dan memberi semangat... Hariyanto (Surabaya) --- On Thu, 31/3/11, Bambang Mahfudin <bambalid@gmail.com> wrote:
|
__._,_.___
No comments:
Post a Comment