Transfer Data Dengan UserForm Vba Excel dari ListBox1 ke ListBox2. Perhatikan gambar format gif dibawah..!! Data Sheet1 yang ditampilkan pada ListBox1 yang dipilih dan di transferkan ke Sheet2 yang ditampilkan pada ListBox2.
Data yang sudah di transfer ke Sheet2 yang di tampilkan melalui ListBox2 selanjut diprint dengan format tertentu yang di tampilkan pada sheet print lengkap dengan Dialog Box pilihan Printer. Data yang ada pada Sheet2 yang di tampilkan pada ListBox2 dapat dihapus dengan Tombol Delete satu persatu atau dengan menggunakan tombol Reset untuk menghapus semua data yang ada pada Sheet2 yang ditampilkan
 |
| Cara Transfer Data, Print, Delete Dan Riset Data Yang Tampil Di ListBox |
Untuk mentranfer data dengan kreteria dan meletakkanya di sheet berdasarkan kreteria sudah saya tuliskan di posting Cara MengCopy/Mentransfer Data Dengan Kreteria Tertentu Ke Sheet Yang Berbeda Menurut Kreteria Masing-Masing
Pada posting ini kita hanya memilih dan secara manual datanya satu persatu dan mentranfer ke sheet lain. Metode ini dapat diterapkan untuk mengambil data dengan tujuan pengguna saja.
Ikuti Langkah-langkah berikut ini dengan baik dan teliti,
- Buka Excel, Gunakan Sheet1 sebagai sumber data yang terdiri dari tabel dengan judul headernya NIS, Nama,Umur, Kelas, dan alamat serta isi tabel dengan data sesuaikan saja dengan selera anda. Sheet2 sebagai penerima transfer data, buat juga header table sesuai dengan Sheet1, namun tanpa isi data. Rename Sheet3 menjadi "PRINT" Format data yang akan di print lihat pada gambar gif diatas saja ketika di print yeah.!!
- Buatlah range dinamis pada Sheet1. Caranya klik Name Manager - New - di kotak dialog Name isikan nama range dengan nama "DATA". Pada kolom Refers to isikan rumus range dibawah ini
=OFFSET(Sheet1!$A$3;0;0;COUNTA(Sheet1!$A$3:$A$95);COUNTA(Sheet1!$A$2:$E$2))
- Buat juga range dinamis di Sheet2 dengan Name "SALINAN" dan copy rumus range dibawah ini cantumkan pada Refers to
=OFFSET(Sheet2!$A$2;1;0;COUNTA(Sheet2!$A:$A);5)
- Langkah berikutnya kita akan bermain di Visual Basic. Klik tab Developer pilih Visual Basic, dan masukkan 1 buah UserForm tambahkan element yang dibutuhkan Perhatikan gambar dibawah ini
Keterangan Elemen yang dibutuhkan :
1. ListBox
ListBox1 atur Properties berikut ini
Rouserce dengan "DATA" yaitu nama range yang ingin ditampilkan di ListBox1.
ColumnHeads pilih "True" untuk menampilkan Headers dari ListBox1.
ColumnWidths dengan "35 pt;80 pt;30.4 pt;40 pt"untuk menentukan ukuran tiap kolom ListBox1.
ListBox2 propertiesnya kita akan atur dengan kode, Masukkan saja kode berikut di UserForm dengan pilih (General)
Sub ListTransfer()
With UserForm1.ListBox2
.RowSource = "SALINAN"
.ColumnHeads = True
.ColumnCount = 5
.BoundColumn = 1
.ColumnWidths = "35 pt; 80 pt; 30 pt; 40 pt"
End With
End Sub
2. Label
Ubah pengaturan properties tiap Label dengan ketentuan berikut ini :
Label1 ubah Caption jadi "Tranfer" dan Name Jadi "LbTransfer"
Label2 ubah Caption jadi "Print" dan Name Jadi "LbPrint"
Label3 ubah Caption jadi "Delete" dan Name jadi "LbDel"
Label4 ubah Caption jadi "Reset" dan Name jadi "LbReset"
Untuk Iconnya agar tampilan lebih indah dan terlihat profesional tinggal dicari saja yeah, tinggal Googling banyak icon yang bisa dipasang sesuai dengan selera masing-masing.
- Jika sudah mengatur element dan propertiesnya sesuai dengan petunjuk diatas, masukkan kode berikut ini di UserForm_Initialize untuk memanggil data yang ditampilkan di ListBox2 saat userform aktif
Private Sub UserForm_Initialize()
'Untuk memanggil data yang akan ditampilkan di ListBox2 secara otomatis
Call ListTransfer
End Sub
- Klik Kanan tombol "Transfer"/"LbTransfer" pilih View Kode, Masukkan kode berikut ini yang berfungsi mengcopy data yang ada pada Sheet1 yang ditampilkan di ListBox1 ke Sheet2 yang ditampilkan pada ListBox2, Berikut Kodenya :
Private Sub LbTransfer_Click()
Dim iListCount As Integer, iColCount As Integer
Dim iRow As Integer
Dim rStartCell As Range
If UserForm1.ListBox1.ListIndex = -1 Then
MsgBox "Data Belum Dipilih, Pilih Data Untuk Transfer", vbExclamation, "Peringatan..!!"
Exit Sub
End If
'Baris Terakhir Entry Data
Set rStartCell = Sheet2.Range("A65536").End(xlUp).Offset(1, 0)
'List Data Mulai dari 0 untuk list data yang dipilih
For iListCount = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iListCount) = True Then 'Pilih Data
ListBox1.Selected(iListCount) = False
iRow = iRow + 1
'Mencari Kolom yang dipilih pada range DATA
For iColCount = 0 To Range("DATA").Columns.Count - 1
'pilih data di tabel dan salin kolom data di Range DATA
rStartCell.Cells(iRow, iColCount + 1).Value = _
ListBox1.List(iListCount, iColCount)
Next iColCount
End If
Next iListCount
Set rStartCell = Nothing
Call ListTransfer
End Sub
- Untuk perintah print. Klik kanan tombol "Print"/"LbPrint" pilih View Code Masukkan kode berikut yang berfungsi untuk mengambil data pada "Sheet2" yang ditampilkan pada ListBox2 untuk di print pada Sheet "PRINT". Berikut kodenya :
Private Sub LbPrint_Click()
'Bila Data Belum Dipilih Kasih Peringatan.
If UserForm1.ListBox2.ListIndex = -1 Then
MsgBox "Data Untuk Print Belum Dipilih, Pilih Data Dulu Yeah..!!", vbExclamation, "Peringatan..!!"
Exit Sub
End If
Application.Visible = True
Unload Me
Sheet3.Range("D3") = ListBox2.List(ListBox2.ListIndex, 0)
Sheet3.Range("D4") = ListBox2.List(ListBox2.ListIndex, 1)
Sheet3.Range("D5") = ListBox2.List(ListBox2.ListIndex, 2)
Sheet3.Range("D6") = ListBox2.List(ListBox2.ListIndex, 3)
Sheet3.Range("D7") = ListBox2.List(ListBox2.ListIndex, 4)
Application.Dialogs(xlDialogPrinterSetup).Show
Sheets("PRINT").PageSetup.Orientation = xlPortrait
Sheets("PRINT").PageSetup.PrintArea = "B2:D8"
Worksheets("PRINT").PrintPreview
Application.Visible = False
UserForm1.Show
End Sub
- Kode berikut ini berfungsi untuk menghapus data pada "Sheet2" yang ditampilkan pada ListBox2 secara satu persatu, yang harus dipilih terlebih dahulu. Klik kanan tombol "Delete"/"LbDel" pilih View Code dan masukkan kode berikut ini :
Private Sub LbDel_Click()
'Bila Data Belum Dipilih Kasih Peringatan.
If UserForm1.ListBox2.ListIndex = -1 Then
MsgBox "Data Untuk Print Belum Dipilih, Pilih Data Dulu Yeah..!!", vbExclamation, "Peringatan..!!"
Exit Sub
End If
'Data akan dieksekusi dengan kode ini
With ListBox2
Dim I As Integer
For I = 2 To 10
If Sheet2.Range("A" & I).Value = ListBox2.Value Then
Sheets("Sheet2").Rows(I).EntireRow.Delete
End If
Next I
End With
End Sub
- Untuk tombol Reset kita menggunakan kode dengan perintah menghapus semua data yang ada pada Sheet2 yang ditampilkan di ListBox2. Klik kanan tombol "Reset"/"LbReset" pilih View Code dan masukkan kode berikut ini :
Private Sub LbReset_Click()
If MsgBox("Anda Yakin Ingin Meriset Ulang..!!!", vbYesNo + 64, "App-Transfer") = vbYes Then
Sheet2.Range("A3:E10").ClearContents
MsgBox "Semua Data Transfer Telah Terhapus Silahkan Transfer Data Baru", vbInformation, "App-Transfer"
Else
MsgBox "Riset Ulang Di Batalkan..!!", vbInformation, "App-Transfer"
End If
Call ListTransfer
End Sub
- Kayaknya udah selesai dech..!! Silahkan di uji aplikasi yang sudah di selesaikan dengan menekan tombol F5 atau klik Run. Jika sudah mengikuti penempatan kode dengan tepat dan benar maka aplikasi akan berjalan sebagaimana diharapkan.
Demikian posting Cara Transfer Data, Print, Delete Dan Riset Data Yang Tampil Di ListBox Dengan UserForm. Semoga dapat disesuaikan dengan kebutuhan masing-masing. Jika ada kendala atau kekurangan dalam posting ini harap disampaikan, dan jika memiliki kode lainnya yang memiliki fungsi yang sama harap bisa disampaikan dalam kolom komentar.