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. 

Cara Membuat Aplikasi VBA Excel Input Data Pada File Berbeda 

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.

Berbagi :