Membaca Struktur Table dan Menerapkannya Dalam GUI

Setelah bepanjang lebar membicarakan Addins, maka sekarang kita akan menerapkannya dalam sebuah project yang bermanfaat (jika dilanjutkan memprogramnya) yaitu: generator database yang sangat sederhana (hanya untuk MS Access saja, untuk database lainnya, silakan modifikasi kodenya). Project ini hanya akan mengenerate GUI-nya saja (tanpa kode), adapun jika jika ingin menambahkan kode-kode yang sesuai Anda dapat merujuk pada tautan di samping, menambah kode pada module (tentu saja setelah dimodifikasi dan disesuaikan).

Langkah-Langkah:

• Buat project Addin
• Masukan kode-kode di bawah ini:

Kode pada frmAddin:

Public VBInstance As VBIDE.VBE 
Public Connect As Connect 
 
Option Explicit 
 
Dim strCon As String 
 
Private Sub cboTables_Click() 
    Set cat = New ADOX.Catalog 
    Set cat.ActiveConnection = DBase 
    Dim c As ADOX.Column 
    lstAll.Clear 
    For Each c In cat.Tables(GetTabelValidName(cboTables.Text)).Columns 
        lstAll.AddItem c.Name 
    Next 
    If lstAll.ListCount > 0 Then lstAll.ListIndex = 0 
    Set cat = Nothing 
End Sub 
 
Private Function GetTabelValidName(strName As String) As String 
    Dim s() As String 
    s = Split(strName, " : ") 
    GetTabelValidName = s(1) 
End Function 
 
Private Sub cmdConnect_Click() 
On Error GoTo ErrHandler 
    strCon = getADOConnectionString() 
    If strCon = "" Then Exit Sub 
    txtCon.Text = strCon 
    If OpenDataBase(strCon) = True Then 
        FillComboWithTables 
    End If 
    Exit Sub 
ErrHandler: 
    MsgBox Err.Number & vbNewLine & Err.Description, vbExclamation + vbOKOnly, "Connection Error" 
    lstAll.Clear 
    cboTables.Clear 
End Sub 
 
Private Function FillComboWithTables() 
    Set cat = New ADOX.Catalog 
    Set cat.ActiveConnection = DBase 
    Dim i As Integer 
    cboTables.Clear 
    lstAll.Clear 
    For i = 0 To cat.Tables.Count - 1 
        If cat.Tables(i).Type <> "SYSTEM TABLE" And cat.Tables(i).Type <> "ACCESS TABLE" Then 
            If cat.Tables(i).Type = "TABLE" Then 
                cboTables.AddItem "Table : " & cat.Tables(i).Name 
            Else 
                cboTables.AddItem "query : " & cat.Tables(i).Name 
            End If 
        End If 
    Next i 
    Set cat = Nothing 
End Function 
 
Private Sub Command1_Click() 
    AddFormAndControls Replace(GetTabelValidName(cboTables.Text), " ", "_"), GetTabelValidName(cboTables.Text) 
End Sub 
 
Private Function AddFormAndControls(f As String, c As String) 
     
    On Error Resume Next 
     
    Dim frm As VBIDE.VBComponent 
    Dim ctl As VBControl 
    Dim frmCurrent As VBForm 
    Dim i As Integer, x As Integer, y As Integer, k As Integer 
    Set frm = VBInstance.ActiveVBProject.VBComponents.Add(vbext_ct_VBForm) 
    Set frmCurrent = VBInstance.SelectedVBComponent.Designer 
     
    For i = 0 To lstAll.ListCount - 1 
        'kode di bawah ini untuk menambah TextBox 
        Set ctl = frmCurrent.VBControls.Add("VB.TextBox") 
        With ctl 
            .Properties("Name") = "txt" & Replace(lstAll.List(i), " ", "_") 
            If i = 0 Then 
                .Properties("Top") = 500 
                x = 500 
            Else 
                x = x + 400 'spasi (jarak) untuk TextBox 
            End If 
            .Properties("Top") = x 
            .Properties("Left") = 2500 
            .Properties("Width") = 4000 
            .Properties("Height") = 330 
            .Properties("Text") = lstAll.List(i) 
            '.properties dan lain-lain, disesuaikan kebutuhan 
        End With 
        If i = lstAll.ListCount - 1 Then 
            y = x + 2000 'Form Height 
            k = x + 900 'CommandButton Top 
        End If 
        'kode di bawah ini untuk menambah label 
        Set ctl = frmCurrent.VBControls.Add("VB.Label") 
        With ctl 
            .Properties("Name") = lstAll.List(i) 
            .Properties("Top") = x 
            .Properties("Left") = 465 
            .Properties("Width") = 2000 
            .Properties("Height") = 255 
            .Properties("Caption") = lstAll.List(i) 
            .Properties("BackStyle") = 0 'transparent 
           '.properties dan lain-lain, disesuaikan kebutuhan 
        End With 
    Next 
    Set ctl = frmCurrent.VBControls.Add("VB.CommandButton") 
    With ctl 
        .Properties("Name") = "cmdUpdate" 
        .Properties("Top") = k 
        .Properties("Left") = 5040 
        .Properties("Width") = 1455 
        .Properties("Height") = 375 
        .Properties("Caption") = "&Update" 
       '.properties dan lain-lain, disesuaikan kebutuhan 
    End With 
    Set ctl = frmCurrent.VBControls.Add("VB.CommandButton") 
    With ctl 
        .Properties("Name") = "cmdCancel" 
        .Properties("Top") = k 
        .Properties("Left") = 3480 
        .Properties("Width") = 1455 
        .Properties("Height") = 375 
        .Properties("Caption") = "&Cancel" 
       '.properties dan lain-lain, disesuaikan kebutuhan 
    End With 
    InsertOCX "{2CDCDF4C-4914-4DBC-99CB-12359BE472E1}" 
    Set ctl = frmCurrent.VBControls.Add("Liner.cLiner") 
    With ctl 
        .Properties("Top") = k - 300 
        .Properties("Left") = -5 
        .Properties("Width") = 7000 
        .Properties("Height") = 30 
    End With 
    With frm 
        .Properties("Name") = "frm" & f 
        .Properties("Width") = 7155 
        .Properties("Caption") = c 
        .Properties("Height") = y 
    End With 
    '-------------------------------------------------------------------------------------------------- 
    'tambahkan kontrol lain-lain ThirdParty OCX 
    'tambahkan pula kode-kode yang sesuai 
    'maaf, belum dibuatkan.... 
    '-------------------------------------------------------------------------------------------------- 
End Function 
 
Public Function InsertOCX(ProgID As String) As Boolean 
On Error GoTo ErrHandler 
    'Add OCX 
     VBInstance.ActiveVBProject.AddToolboxProgID ProgID 
    InsertOCX = True 
Exit Function 
ErrHandler: 
    InsertOCX = False 
End Function 

Kode pada modDatabase:

Option Explicit 
 
Public DBase As New ADODB.Connection 
Public cat As ADOX.Catalog 
 
Function OpenDataBase(sFilename As String) As Boolean 
    '// Membuat koneksi ke database 
    Set DBase = New ADODB.Connection 
    With DBase 
        .CursorLocation = adUseClient 
        .Open "Provider= Microsoft.Jet.OLEDB.4.0;Persist security info=False;Data Source=" & sFilename & ";Jet OLEDB:Database;" 
    End With 
    OpenDataBase = True 
End Function 

Kode pada modDataLinks: silakan copy dan pastekan dari tautan di samping module data links.

• Rubahlah menu Addins yang akan ditampilkan dengan merujuk pada link ini.
• Tambahkan satu OCX yang dibutuhkan download disini.
• Selesai. Anda bisa mengujinya sekarang, dengan cara mengcompilennya atau tanpa compile seperti posting yang telah ditulis terdahulu.
• Jika hasilnya sama seperti ini [download project jadi], maka saya ucapkan: selamat Anda berhasil!