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

For Each wb In Application.Workbooks

If wb.Name = AcuanDataBase Then

BukaAjhaYaH = False

Exit For

End If

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

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.

Go to Link

5 komentar

mahrusyahafidz 5 Agustus 2017 pukul 10.31

contoh filenya yng bisa di download?
1. Admin 5 Agustus 2017 pukul 17.28
  
  File Vba Excel Syarat dan ketentuan berlaku..
Anonim 25 Agustus 2017 pukul 16.39

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?
Heru_ayah_Zidane 16 Mei 2018 pukul 14.04

mas udah saya coba step stepnya kok ga bisa di run ya, muncul error runtime error 1004
method range of global failed

klo pada bagian Private Sub UserForm_Initialize() saya hapus bisa jalan tpi ga bisa di save dan muncul error juga? salahnya dimana ya?
Anonim 9 Oktober 2018 pukul 21.47

filenya mna?

Komentar Anda Sangat Menentukan Kelangsungan Blog ini

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

5 komentar

Cari Data Dengan TextBox Tampil Di ListBox

Aplikasi Absensi Gratis

Cara Masukkan/Insert Foto Kedalam Aplikasi Dengan UserForm VBA Excel

Perintah Print Preview Melalui UserForm VBA Excel

Cara Membuat UserForm Muncul Otomatis Ketika Excel Dibuka