Monday, July 3, 2017

Cara Membuat Aplikasi VBA Excel Input Data Pada File Berbeda Bagian 2

Cara Membuat Aplikasi VBA Excel Input Data Pada File Berbeda Bagian 2 - Posting ini kelanjutan dari yang sebelumnya. Pada bagian 1 kita sudah membuat DataBase sebagai tempat penyimpanan data serta dengan header tabelnya. Pada bagian 1 kita juga sudah membuat FormAplikasi yang mempunya fungsi hanya untuk Form Entry data, dan data yang di entry akan masuk ke dalam file database. Jadi yang belum membaca posting terdahulu pada bagian 1 maka diharapkan untuk bisa membaca dan merancang sebagaimana yang telah ditulis pada posting tersebut.

Pada bagian 2 ini kita akan memasukkan kode Vba Excel  yang akan menjalankan fungsi aplikasi nantinya. Kita akan memasukkan Kode Vba hanya pada File FormAplikasi yang telah kita simpan dalam format macro(xlsm). Sementara File DataBase.xlsx hanya berfungsi tempat menampung data saja. Cara ini akan menghemat size aplikasi, karena data tidak di simpan dalam file FormAplikasi. Ikut langkah-langkahnya dengan teliti agar aplikasi yang kita rancang berjalan sebagaimana mestinya.


Langkah-langkah Cara Membuat Aplikasi VBA Excel Input Data Pada File Berbeda Bagian 2
  • Klik kanan pada UserForm1, pilih View Code dan tulislah kode berikut ini pada obyek (General) dengan event ( Declarations), 
Option Explicit

Const KodNomUrut As Integer = 1
Const KodNomInduk As Integer = 2
Const KodNamSis As Integer = 3
Const KodAlamak As Integer = 4
Const KodDes As Integer = 5
Const KodCam As Integer = 6
Const KodKab As Integer = 7
Const KodProv As Integer = 8
Const KodPos As Integer = 9
Const KodYah As Integer = 10
Const KodEmak As Integer = 11
Const KodPE As Integer = 12
Const IndekMinim As Byte = 2
Const MatiWarTextBox As Long = -2147483633
Const HidupWarTextBox As Long = -2147483643
Const NamDataBaseYa As String = "SENBAKUSEN"

Private WsDaftar As Worksheet
Private WbDaftar As Workbook
Private IndekDaft As Long
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (UpdatReg)
Private Sub UpdatReg()
    lblNavigator.Caption = IndekDaft - 1 & " de " & WsDaftar.UsedRange.Rows.Count - 1
    LbInfo.Caption = ""
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (AturDataBaseYa)
Private Sub AturDataBaseYa()
    Dim BukaAjhaYaH As Boolean
    Dim wb As Workbook
    Dim LengkapiYa As String
    Dim AcuanDataBase As String
    Dim PasteData As String
 
    BukaAjhaYaH = True
 
    AcuanDataBase = Range("AcuanDataBase").Value
    PasteData = Range("PasteData").Value
 
    If ThisWorkbook.Name <> AcuanDataBase Then
        '
        If PasteData = vbNullString Or PasteData = "" Then
            LengkapiYa = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & AcuanDataBase
        Else
            If Right(PasteData, 1) = "\" Then
                LengkapiYa = PasteData & AcuanDataBase
            Else
                LengkapiYa = PasteData & "\" & AcuanDataBase
            End If
        End If
     

        For Each wb In Application.Workbooks
            If wb.Name = AcuanDataBase Then
                BukaAjhaYaH = False
                Exit For
            End If
        Next
     

        If BukaAjhaYaH Then
            Set WbDaftar = Workbooks.Open(Filename:=LengkapiYa, ReadOnly:=True)
        Else
            Set WbDaftar = Workbooks(AcuanDataBase)
        End If
    Else
        Set WbDaftar = ThisWorkbook
    End If
 
    Set WsDaftar = WbDaftar.Worksheets(NamDataBaseYa)
 

    WbDaftar.Windows(1).Visible = False
 
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (BerikutnyaYa)
Private Function BerikutnyaYa() As Long
    Dim rangeIds As Range
    'mengacu pada kode kolom (ID)
    Set rangeIds = WsDaftar.Range(WsDaftar.Cells(IndekMinim, KodNomUrut), WsDaftar.Cells(WsDaftar.UsedRange.Rows.Count, KodNomUrut))
    BerikutnyaYa = WorksheetFunction.Max(rangeIds) + 1
End Function
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (BersihForm)
Private Sub BersihForm()
    Me.TextBox1.Text = ""
    Me.TextBox2.Text = ""
    Me.TextBox3.Text = ""
    Me.TextBox4.Text = ""
    Me.TextBox5.Text = ""
    Me.TextBox6.Text = ""
    Me.TextBox7.Text = ""
    Me.TextBox8.Text = ""
    Me.TextBox9.Text = ""
    Me.TextBox10.Text = ""
    Me.TextBox11.Text = ""
    Me.TextBox12.Text = ""
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (BolehKontroYa)
Private Sub BolehKontroYa()

    Me.TextBox2.Locked = False
    Me.TextBox3.Locked = False
    Me.TextBox4.Locked = False
    Me.TextBox5.Locked = False
    Me.TextBox6.Locked = False
    Me.TextBox7.Locked = False
    Me.TextBox8.Locked = False
    Me.TextBox9.Locked = False
    Me.TextBox10.Locked = False
    Me.TextBox11.Locked = False
    Me.TextBox12.Locked = False

    Me.TextBox2.BackColor = HidupWarTextBox
    Me.TextBox3.BackColor = HidupWarTextBox
    Me.TextBox4.BackColor = HidupWarTextBox
    Me.TextBox5.BackColor = HidupWarTextBox
    Me.TextBox6.BackColor = HidupWarTextBox
    Me.TextBox7.BackColor = HidupWarTextBox
    Me.TextBox8.BackColor = HidupWarTextBox
    Me.TextBox9.BackColor = HidupWarTextBox
    Me.TextBox10.BackColor = HidupWarTextBox
    Me.TextBox11.BackColor = HidupWarTextBox
    Me.TextBox12.BackColor = HidupWarTextBox
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (BolehUbahYa)
Private Sub BolehUbahYa()
'memungkinkan kunci modifikasi
    OptEdit.Enabled = True
    OptHapus.Enabled = True
    OptBaru.Enabled = True
    CmdOK.Enabled = False
    CmdCancel.Enabled = False

    'Matikan Tombol Option
    OptEdit.Value = False
    OptHapus.Value = False
    OptBaru.Value = False
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (CariIndekIdYa)
Public Function CariIndekIdYa(ByVal id As Long) As Long
    Dim i As Long
    Dim SupermanReturn As Long
    Dim CilubBhaBha As Boolean

    i = IndekMinim
    With WsDaftar
        Do While Not IsEmpty(.Cells(i, KodNomUrut))
            If .Cells(i, KodNomUrut).Value = id Then
                SupermanReturn = i
                CilubBhaBha = True
                Exit Do
            End If
            i = i + 1
        Loop
    End With

    'Jika Anda tidak dapat menemukan catatan, mengembalikan -1
    If Not CilubBhaBha Then
        SupermanReturn = -1
    End If

    CariIndekIdYa = i
End Function
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (DaftAjha)
Private Sub DaftAjha()
'load data record pertama
    With WsDaftar
        If Not IsEmpty(.Cells(IndekDaft, KodNomUrut)) Then
            Me.TextBox1.Text = .Cells(IndekDaft, KodNomUrut).Value
            Me.TextBox2.Text = .Cells(IndekDaft, KodNomInduk).Value
            Me.TextBox3.Text = .Cells(IndekDaft, KodNamSis).Value
            Me.TextBox4.Text = .Cells(IndekDaft, KodAlamak).Value
            Me.TextBox5.Text = .Cells(IndekDaft, KodDes).Value
            Me.TextBox6.Text = .Cells(IndekDaft, KodCam).Value
            Me.TextBox7.Text = .Cells(IndekDaft, KodKab).Value
            Me.TextBox8.Text = .Cells(IndekDaft, KodProv).Value
            Me.TextBox9.Text = .Cells(IndekDaft, KodPos).Value
            Me.TextBox10.Text = .Cells(IndekDaft, KodYah).Value
            Me.TextBox11.Text = .Cells(IndekDaft, KodEmak).Value
            Me.TextBox12.Text = .Cells(IndekDaft, KodPE).Value
        End If
    End With

    Call UpdatReg
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (DaftAjhaPorIndice)
Public Sub DaftAjhaPorIndice(ByVal indice As Long)
'load data registrasi yang berbasis di indeks
    IndekDaft = indice

    Call DaftAjha
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (DataAwaiYa)
Private Sub DataAwaiYa()
    IndekDaft = 2
    Call DaftAjha
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (MatiControl)
Private Sub MatiControl()

    Me.TextBox2.Locked = True
    Me.TextBox3.Locked = True
    Me.TextBox4.Locked = True
    Me.TextBox5.Locked = True
    Me.TextBox6.Locked = True
    Me.TextBox7.Locked = True
    Me.TextBox8.Locked = True
    Me.TextBox9.Locked = True
    Me.TextBox10.Locked = True
    Me.TextBox11.Locked = True
    Me.TextBox12.Locked = True

    Me.TextBox2.BackColor = MatiWarTextBox
    Me.TextBox3.BackColor = MatiWarTextBox
    Me.TextBox4.BackColor = MatiWarTextBox
    Me.TextBox5.BackColor = MatiWarTextBox
    Me.TextBox6.BackColor = MatiWarTextBox
    Me.TextBox7.BackColor = MatiWarTextBox
    Me.TextBox8.BackColor = MatiWarTextBox
    Me.TextBox9.BackColor = MatiWarTextBox
    Me.TextBox10.BackColor = MatiWarTextBox
    Me.TextBox11.BackColor = MatiWarTextBox
    Me.TextBox12.BackColor = MatiWarTextBox
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (MatiKEdit)
Private Sub MatiKEdit()
'menonaktifkan tombol modifikasi
    OptEdit.Enabled = False
    OptHapus.Enabled = False
    OptBaru.Enabled = False
    CmdOK.Enabled = True
    CmdCancel.Enabled = True
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (RegData)
Private Sub RegData(ByVal id As Long, ByVal indice As Long)
    'mencoba untuk membuka file dalam modus menulis
    Call SegarkanYa(False)
 
    With WsDaftar
        .Cells(indice, KodNomUrut).Value = id
        .Cells(indice, KodNomInduk).Value = Me.TextBox2.Text
        .Cells(indice, KodNamSis).Value = Me.TextBox3.Text
        .Cells(indice, KodAlamak).Value = Me.TextBox4.Text
        .Cells(indice, KodDes).Value = Me.TextBox5.Text
        .Cells(indice, KodCam).Value = Me.TextBox6.Text
        .Cells(indice, KodKab).Value = Me.TextBox7.Text
        .Cells(indice, KodProv).Value = Me.TextBox8.Text
        .Cells(indice, KodPos).Value = Me.TextBox9.Text
        .Cells(indice, KodYah).Value = Me.TextBox10.Text
        .Cells(indice, KodEmak).Value = Me.TextBox11.Text
        .Cells(indice, KodPE).Value = Me.TextBox12.Text
    End With
 
    'menyimpan file
    Call WbDaftar.Save
 
    'membuka file lagi dalam modus baca
    Call SegarkanYa(True)

    Call UpdatReg
End Sub
  • Tulislah kode berikut ini pada obyek (General) Eventnya akan muncul otomatis mengikuti kode yang di tulis yaitu (SegarkanYa)
Private Sub SegarkanYa(ByVal ReadOnly As Boolean)
    Dim LengkapiYa As String
    'menutup file data dan mencoba untuk membukanya
    'menjaga Keamanan
    LengkapiYa = WbDaftar.FullName
    WbDaftar.Saved = True
    WbDaftar.Close SaveChanges:=False
 
    'membuka file dalam modus menulis
    Set WbDaftar = Workbooks.Open(Filename:=LengkapiYa, ReadOnly:=ReadOnly)
 
    'menyembunyikan jendela
    WbDaftar.Windows(1).Visible = False
 
    'reassigns lembar pendaftaran
    Set WsDaftar = WbDaftar.Worksheets(NamDataBaseYa)
End Sub
  • Tulislah kode berikut ini pada obyek (UserForm), dengan  Eventnya Initialize
Private Sub UserForm_Initialize()

    Call AturDataBaseYa
    Call BolehUbahYa
    Call DataAwaiYa
    Call MatiControl
   
End Sub
  • Klik kanan tombol OptBaru dengan Caption Baru pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol OptBaru dengan Caption Baru dipilih.
Private Sub OptBaru_Click()
    Call BersihForm
    Call BolehKontroYa
    Call MatiKEdit
    'dmemberikan fokus ke data kontrol pertama
    TextBox2.SetFocus
End Sub
  • Klik kanan tombol OptEdit dengan Caption Edit pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol OptEdit dengan Caption Edit dipilih.
Private Sub OptEdit_Click()
    If TextBox1.Text <> vbNullString And TextBox1.Text <> "" Then
        Call BolehKontroYa
        Call MatiKEdit
        'memberikan fokus ke data kontrol pertama
        TextBox2.SetFocus
    Else
        LbInfo.Caption = "Tidak Ada Data Yang Harus Di Edit"
    End If
End Sub
  • Klik kanan tombol OptHapus dengan Caption Hapus pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol OptHapus dengan Caption Hapus dipilih.
Private Sub OptHapus_Click()
    If TextBox1.Text <> vbNullString And TextBox1.Text <> "" Then
        Call MatiKEdit
        LbInfo.Caption = "Ceks Dengan Teliti..!!"
    Else
        LbInfo.Caption = "Tidak Ada Data Yang Akan dihapus"
    End If
End Sub

  • Klik kanan tombol CmdOk dengan Caption OK pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdOK dengan Caption OK diklik.
Private Sub CmdOK_Click()
    Dim BacaIdTrus As Long

    'Edit
    If OptEdit.Value Then
        Call RegData(CLng(TextBox1.Text), IndekDaft)
        LbInfo.Caption = "Alhamdulillah..!! Data Sukses Di Simpan..!!"
    End If
    'DataBaru
    If OptBaru.Value Then
        BacaIdTrus = BerikutnyaYa
        'Ambil Baris Berikutnya
        Dim IsiTrus As Long
        'DimasukkanDatanya ne..
        Call SegarkanYa(False)
        IsiTrus = WsDaftar.UsedRange.Rows.Count + 1
        Call RegData(BacaIdTrus, IsiTrus)
        TextBox1 = BacaIdTrus
        LbInfo.Caption = "Alhamdulillah..!! Data Sukses Di Simpan..!!"
    End If
    'hapus
    If OptHapus.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Anda Yakin Akan Menghapus Data " & TextBox1.Text & " ?", vbYesNo, "Kompirmasi")

        If result = vbYes Then
            'membuka file untuk menulis
            Call SegarkanYa(False)
            WsDaftar.Range(WsDaftar.Cells(IndekDaft, KodNomUrut), WsDaftar.Cells(IndekDaft, KodNomUrut)).EntireRow.Delete
            'Simpan
            WbDaftar.Save
            'Buka Tapi Lindungi
            Call SegarkanYa(True)
            Call DataAwaiYa
            LbInfo.Caption = "Data Berhasil Di Hapus..!!"
        End If
    End If

    Call BolehUbahYa
    Call MatiControl

End Sub
  • Klik kanan tombol CmdCancel dengan Caption Cancel pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdCancel dengan Caption Cancel diklik.
Private Sub CmdCancel_Click()
    CmdOK.Enabled = False
    CmdCancel.Enabled = False
    Call MatiControl
    Call DataAwaiYa
    Call BolehUbahYa
End Sub
  • Klik kanan tombol CmdHome dengan Caption Home pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdHome dengan Caption Home diklik.
Private Sub CmdHome_Click()
    IndekDaft = IndekMinim
    If IndekDaft > 1 Then
        Call DaftAjha
    End If
End Sub
  • Klik kanan tombol CmdPrev dengan Caption Previous pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdPrev dengan Caption Previous diklik.
Private Sub CmdPrev_Click()
    If IndekDaft > IndekMinim Then
        IndekDaft = IndekDaft - 1
    End If
    If IndekDaft > 1 Then
        Call DaftAjha
    End If
End Sub
  • Klik kanan tombol CmdNext dengan Caption Next pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdNext dengan Caption Next diklik.
Private Sub CmdNext_Click()
    If IndekDaft < WsDaftar.UsedRange.Rows.Count Then
        IndekDaft = IndekDaft + 1
    End If
    If IndekDaft > 1 Then
        Call DaftAjha
    End If
End Sub
  • Klik kanan tombol CmdEnd dengan Caption End pilih View Code dan tulislah kode berikut ini untuk memberikan perintah jika tombol CmdEnd dengan Caption End diklik.
Private Sub CmdEnd_Click()
    IndekDaft = WsDaftar.UsedRange.Rows.Count
    If IndekDaft > 1 Then
        Call DaftAjha
    End If
End Sub

Demikian Posting Cara Membuat Aplikasi VBA Excel Input Data Pada File Berbeda Bagian 2. Semoga dapat dipelajari dan dijadikan referensi bagi pengunjung blog yang pernah bertanya dan menjadi pengalaman baru dalam belajar otodidak bagi yang membaca posting ini. Admin blog juga mohon maaf terhadap penjelasan yang kurang pada tiap baris kode. Itu semua dikarenakan admin sendiri tidak mengerti tiap bari kode. yang admin lakukan hanya mencoba mempraktekkan saja.

Nama Admin Zaki Fitriadi, Pengangguran, Blogger Awam Kelahiran Banda Aceh 1982, Mengenal Blog Tahun 2010, Baru Aktif Tahun 2015, Berbagi Apa Yang Dipejari Secara Otodidak di Dunia Maya

3 komentar

contoh filenya yng bisa di download?

File Vba Excel Syarat dan ketentuan berlaku..

misal hasil database yg datanya tersusun pada satu baris mau di copy paste ke tabel yg berbeda urutan/susunannya (misal ada yg dibaris kedua letaknya), bgmn gan?

Komentar Anda Sangat Menentukan Kelangsungan Blog ini
EmoticonEmoticon