Belajar Excel vba Menampilkan Daftar sheet di listbox

Menampilakan sheet dan import sheet pilihan

 Pastekan pada kode berikut CommandButton1

             

Private Sub CommandButton1_Click()

 Sheets("DATAGROUP").Range("A5:C17").Value = ""

    For k = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(k) Then

        Sheets(ListBox1.List(k)).Select

        Sheets(ListBox1.List(k)).Cells.SpecialCells(xlLastCell).Select

        Range(Selection, Cells(1, 1)).Select

        End If

        Next

Set salin = ActiveSheet.Range("A5:C17")

Set simpan = Sheets("DATAGROUP").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0)

salin.Copy

simpan.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

Sheets("DATAGROUP").Range("A3").Value = ActiveSheet.Range("A3").Value

Sheets("DATAGROUP").Select

End Sub

Pastekan pada kode berikut Pada Userform 

Private Sub UserForm_Initialize()

 For k = 2 To 7

        ListBox1.AddItem Sheets(k).Name

    Next

End Sub

 Unduh sampel file xlsm >>>>   disini

Sekian semoga bermanfaat !

Hyperling antar sheet

Membuat tombol hyperling dibanyak sheet cukup memakan

 waktu kode ini sangat membantu dengan hyperling otomatis 

sebanyak sheet yang ada di wookbook

Private Sub ListBox1_Click()

For k = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(k) Then

        Sheets(ListBox1.List(k)).Select

        Sheets(ListBox1.List(k)).Cells.SpecialCells(xlLastCell).Select

        Range(Selection, Cells(1, 1)).Select

   End If

Next

End Sub

Private Sub UserForm_Initialize()

 For k = 1 To Sheets.Count

        ListBox1.AddItem Sheets(k).Name

    Next

    End Sub

Form VBA Membuat Banyak sheet sekaligus

Private Sub CommandButton1_Click()
Call Hapus
Sheets("data").Range("A6:k110").Value = ""
a = Val(TextBox1.Text)
b = TextBox2.Value
c = a + 5
    No = 0
For NOMOR = 1 To a
No = No + 1
Cells(No + 5, 1).Value = No
Next NOMOR

For i = 6 To c
Cells(i, 2) = b
Next i

[k6:k106].Formula = "=CONCATENATE(b6, a6)"
Application.DisplayFormulaBar = False

'copy filter dan buat sheet baru

Dim sheetCopy As Worksheet
Dim sheetPaste As Worksheet
Dim sheetBuat As Worksheet
Dim Rng As Range

Set sheetCopy = ThisWorkbook.Worksheets("Data")
Set Rng = sheetCopy.Range("c5")

Dim iRowAwal As Integer
Dim iRowAkhir As Integer
Dim iRowTujuan As Integer
Dim sheetFilter As String
Dim sheetSama As Boolean

iRowAkhir = sheetCopy.Cells(sheetCopy.Rows.Count, 1).End(xlUp).Row
For iRowAwal = Rng.Row To iRowAkhir
sheetSama = False
sheetFilter = sheetCopy.Cells(iRowAwal, 11).Text
     For Each sheetBuat In ThisWorkbook.Worksheets
      If sheetFilter = sheetBuat.Name Then
            Set sheetPaste = sheetBuat
            sheetSama = True
            Exit For
        End If
    Next
    If Not sheetSama Then
        Set sheetPaste = ThisWorkbook.Worksheets.Add(before:=sheetCopy)
        sheetPaste.Name = sheetFilter
    End If
    sheetCopy.Rows(5).Copy sheetPaste.Rows(5)
    iRowTujuan = sheetPaste.Cells(sheetPaste.Rows.Count, 1).End(xlUp).Row
    sheetCopy.Rows(iRowAwal).Copy sheetPaste.Rows(iRowTujuan + 1)
Next iRowAwal
sheetCopy.Select
Set Rng = Nothing
Set sheetCopy = Nothing
Sheets("data").Range("A6:k110").Value = ""
Unload Me
Sheets("data").Select
End Sub

Private Sub CommandButton2_Click()
Dim sheet As Worksheet
Application.DisplayAlerts = False
For Each sheet In ThisWorkbook.Worksheets
If LCase(sheet.Name) <> "data" Then sheet.Delete
Next
Application.DisplayAlerts = True
Sheets("data").Range("O1:O200").Value = ""
Unload Me
End Sub


Private Sub ListBox1_Click()
For k = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(k) Then
        Sheets(ListBox1.List(k)).Select
        Sheets(ListBox1.List(k)).Cells.SpecialCells(xlLastCell).Select
        Range(Selection, Cells(1, 1)).Select
   End If
Next
End Sub

Private Sub TextBox1_Change()
If TextBox1 = vbNullString Then Exit Sub
If Not IsNumeric(TextBox1) Then
MsgBox "Maaf, hanya data berupa angka yang diijinkan", 16, "Validasi"
TextBox1 = vbNullString
End If
End Sub



Private Sub UserForm_Initialize()
 For k = 2 To Sheets.Count
        ListBox1.AddItem Sheets(k).Name
    Next
    End Sub

sampel file silahkan unduh pada tautan berikut :
Membuat Banyak Sheet sekaligus

Input dan interior color

Input interior color
Kode Input Pastekan Kode Pada CommandButton1

Private Sub CommandButton1_Click()
Dim iRow As Long
Sheets("Sheet1").Activate
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value

Mewarnai Interior oleh TextBox6
Cells(iRow, 2).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 3).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 4).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 5).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 6).Interior.ColorIndex = TextBox6.Value

Mewarnai tex TextBox7
Cells(iRow, 2).Font.ColorIndex = TextBox7.Value
Cells(iRow, 3).Font.ColorIndex = TextBox7.Value
Cells(iRow, 4).Font.ColorIndex = TextBox7.Value
Cells(iRow, 5).Font.ColorIndex = TextBox7.Value
Cells(iRow, 6).Font.ColorIndex = TextBox7.Value
End Sub


Mengisi nilai di TextBox6 oleh SpinButton1
Private Sub SpinButton1_Change()
TextBox6.Value = SpinButton1
End Sub
Mengisi nilai di TextBox7 oleh SpinButton2
Private Sub SpinButton2_Change()
TextBox7.Value = SpinButton2
End Sub

Input Kreteria Multi Tabel baris

Input interior color
Kode Input Pastekan Kode Pada CommandButton1

Private Sub CommandButton1_Click()
Dim iRow As Long
Sheets("Sheet1").Activate
iRow = WorksheetFunction.CountA(Range("b:b")) + 5
Cells(iRow, 2).Value = TextBox1.Value
Cells(iRow, 3).Value = TextBox2.Value
Cells(iRow, 4).Value = TextBox3.Value
Cells(iRow, 5).Value = TextBox4.Value
Cells(iRow, 6).Value = TextBox5.Value

Mewarnai Interior oleh TextBox6
Cells(iRow, 2).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 3).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 4).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 5).Interior.ColorIndex = TextBox6.Value
Cells(iRow, 6).Interior.ColorIndex = TextBox6.Value

Mewarnai tex TextBox7
Cells(iRow, 2).Font.ColorIndex = TextBox7.Value
Cells(iRow, 3).Font.ColorIndex = TextBox7.Value
Cells(iRow, 4).Font.ColorIndex = TextBox7.Value
Cells(iRow, 5).Font.ColorIndex = TextBox7.Value
Cells(iRow, 6).Font.ColorIndex = TextBox7.Value
End Sub


Mengisi nilai di TextBox6 oleh SpinButton1
Private Sub SpinButton1_Change()
TextBox6.Value = SpinButton1
End Sub
Mengisi nilai di TextBox7 oleh SpinButton2
Private Sub SpinButton2_Change()
TextBox7.Value = SpinButton2
End Sub

Calkulator dgn Texbox

Membuat Kalkulator Sederhana

Nilai pada sebuah texbox di deklarasikan dengan val
Misalnya :
Val(Text2.Text) untuk nilai untuk texbox2
Dan sebagainya

Untuk menjumlahkan nilai texbox1 dan texbox2  yang hasilnya di texbox3
maka ditulis sebagai berikut :

a = Val(Text1.Text) 
b = Val(Text2.Text)
r = a + b
Text3.Text = r

Keterangan:
a dideklarasikan sebagai nilai untuk texbox1
b dideklarasikan sebagai nilai untuk texbox2
r dideklarasikan sebagai nilai untuk texbox3

maka nilai r = a + b


demikian pula untuk mencari nilai pengurangan atau perkalian akan dideklarasikan dengan contoh berikut sebagai berikut

r = a - b  mendapatkan hasil pengurangan
r = a * b  mendapatkan hasil perkalian

mari kita aplikasikan code vba tersebut untuk membuat kalkulator sederhana

cukup mudah caranya siapka sebuah userform
dengan 3 buah texbox yakni
texbox1 , texbox2 dan texbox3
4 buah Commandbutton yakni
Commandbutton1
Commandbutton2
Commandbutton3
Commandbutton4

Pastekan kode pada  CommandButton1

Private Sub CommandButton1_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a + b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton2

Private Sub CommandButton2_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a - b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton3


Private Sub CommandButton3_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a * b
Text3.Text = r
End Sub

Pastekan kode pada  CommandButton4


Private Sub CommandButton4_Click()
a = Val(Text1.Text)
b = Val(Text2.Text)
r = a / b
Text3.Text = r
End Sub

Pastekan kode pada  sebuah modul yang nantinya digunakan untuk memanggil userform

Sub panggil ()
Userform1.show
End sub

Selesai
semoga bermanfaat

Sampel file dapat didownload di link berikut


 

Format Value Texbox

         Format Value Texbox

Format value sama halnya dengan format cell dilembar excel .Namun di userform pada texbox dikenal dgn format Value atau isi
Contoh beberapa format value pada texbox diantaranya

1 Format  angka 8 digit

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox1.Value = Format(TextBox2.Value, "000000000000000")
End Sub

'2.Contoh format date atau tanggal :

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Dim dDate As Date
dDate = DateSerial(Year(Date), Month(Date), Day(Date))
TextBox2.Value = Format(TextBox2.Value, "dd/mm/yyyy")
dDate = TextBox2Value
End Sub

'3.Contoh format Currency Mata Uang

Private Sub TextBox3_Change()
TextBox3.Value = Format(TextBox2.Value, "$#,##0.00")
End Sub

'4.Contoh format  persen

Private Sub TextBox4_Change()
TextBox4.Value = Format(TextBox2.Value, "0.00%")
End Sub

'5,Contoh format  menit

Private Sub TextBox5_Change()
TextBox5.Value = Format(TextBox5.Value, " h:mm:ss AM/PM;@")
End Sub

Selesai
Semoga bermanfaat

Combobox Bertingkat

            Combobox Bertingkat

Pembahasan kali ini adalah bagaimana Menampilkan Isian List pada Beberapa Combobox yang saling berkaitan antar combobox satu dengan yang lain dan memenuhi kretria yg sdh ditentukan
Misalnya list yang tampil di combobok2 harus sesuai pilihan yg diberikan oleh combobox1
Demikian pula list yang tampil di combobox3 harus sesuai dengan pilihan yg diberikan oleh combobox2
Sistem Seperti ini disebut Orang dengan “ Combobox Bertingkat “

Cara Membuatnya  mari ikuti langkah – langkah berikut :
Buatlah sebuah Userform dan  Sebuah Tabel di sheet1 seperti gambar1 dan gambar2 diatas kemudian buatlah 3 combobox Yang terdiri dari

ComboBox1
ComboBox2
ComboBox3

Buatlah Tabel listdi sheet1 seperti gambar2 diatas

Pastekan Kode berikut pada ComboBox1

Private Sub ComboBox1_Change()
ComboBox2.Text = ""
ComboBox3.Text = ""
If ComboBox1.Text = Sheets("sheet1").Range("a2").Value Then
ComboBox2.List = Sheet1.Range("B5:B7").Value
ElseIf ComboBox1.Text = Sheets("sheet1").Range("a3").Value Then
ComboBox2.List = Sheet1.Range("b8:b10").Value
ElseIf ComboBox1.Text = Sheets("sheet1").Range("a4").Value Then
ComboBox2.List = Sheet1.Range("b11:b13").Value
End If
End Sub

Pastekan Kode berikut pada ComboBox2


Private Sub ComboBox2_Change()
ComboBox3.Text = ""
If ComboBox2.Text = Sheets("sheet1").Range("B5").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d5:m5").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B6").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d6:m6").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B7").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d7:m7").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B8").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d8:m8").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B9").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d9:m9").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B10").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d10:m10").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B11").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d11:m11").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B12").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d12:m12").Value)

ElseIf ComboBox2.Text = Sheets("sheet1").Range("B13").Value Then
ComboBox3.List = Application.Transpose(Sheet1.Range("d13:m13").Value)
End If
End Sub

Pastekan Kode berikut pada useform

Private Sub UserForm_Initialize()
ComboBox1.List = Sheet1.Range("a2:a4").Value
End Sub

Selesai
Semoga bermanfaat
Sampel file dapat di unduh pada link dibawah ini





 Combobox Bertingkat 

Combobox List Pilihan

           Combobox Pilihan List

Membuat list pilihan pada combobox cukup mudah caranya
Buatlah userform dan table disheet1 seperti gambar diatas
Kemudian pastekan  kode vba berikut ini :

pada CommandButton1

Private Sub ComboBox1_Change()
CommandButton1_Click
End Sub

pada CommandButton1

Private Sub CommandButton1_Click()
If ComboBox1.Text = "Sultra" Then
ComboBox2.Text = ""
ComboBox2.List = Sheet1.Range("B5:B20").Value
ElseIf ComboBox1.Text = "Bali" Then
ComboBox2.Text = ""
ComboBox2.List = Sheet1.Range("C5:C20").Value
End If
End Sub

pada userform

Private Sub UserForm_Initialize()
ComboBox1.AddItem "Sultra"
ComboBox1.AddItem "Bali"
End Sub


Selesai
Semoga bermanfaat
Dapatkan sampel file pada link dibawah ini

Validasi Data Texbox

      Validasi Data Texbox

Validasi Data pada Texbox memungkin pengguna aplikasi memenuhi persyaratan dalam melakukan input pada sebuah texbox
Misalkan seorang penggunakan harus mengimput nominal atau bukan text demikian pula harus jumlah yang diimput harus memenuhi sayar yang sdh ditentukan misalnya nominal minimal 1 juta dan sebagainya
Caranya cukup mudah
Buat sebuah form input dengan 2 buah texbox dan satu tombol input

Pada tombol input pastekan kode

Private Sub CommandButton1_Click()
Dim irow As Long
irow = Worksheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row
Worksheets("data").Cells(irow, 2).Value = TextBox1.Value
Worksheets("data").Cells(irow, 3).Value = TextBox2.Value
End Sub


Pada Userform pastekan kode berikut :

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Validasi angka TextBox
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
MsgBox "Maaf, hanya data berupa angka yang diijinkan", 16, "Validasi"
End Select
End Sub

Pada Texbox2 pastekan code berikut:

Private Sub TextBox2_Change()
If TextBox2 = vbNullString Then Exit Sub
If TextBox2 > 1000000 Then
MsgBox " Maaf ! Jumlah Transfer Anda lebih dari 1 juta" & vbCrLf & " Silahkan logi terlebih dahulu!", vbYesNo + vbCritical, "Caution"
TextBox2 = vbNullString
Cancel = True
End If
End Sub

Sekian silahkan di coba
Semoga bermanfaat
Tiada suatu yang susah bila tekun dipelajari
Salam

File sampel pada link berikut



 Texbox Validasi 

Color Active Cell

         Color active Cell

mewarnai cell aktif tidak terlepas dari kode Warna Properti
yang diaplikasi dengan sebuah nilai
cek pembahasan sebelumnya yakni color indek
Cara  juga hanya perlu membuat sebuah modul
Pastekan kode berikut

Private Sub CommandButton1_Click()
Selection.Cells.Font.ColorIndex = 1  ' 5=Biru
Selection.Cells.Interior.ColorIndex = 8  ' 5=Biru
Unload Me
End Sub

Private Sub CommandButton2_Click()
Selection.Cells.Font.ColorIndex = 2  ' 5=Biru
Selection.Cells.Interior.ColorIndex = 3  ' 5=Biru
Unload Me
End Sub

Selesai
Silahkan dicoba dilembar kerja excel anda

Mewarnai UserForm

UserForm Tampil Full

        USERFORM FULL DEKSTOP

Materi  Pembelajaran VBA kali ini adalah bagaimana kita menampilkan sebuah userform tampil full di desktop pada computer anda

Cukup mudah caranya ikuti langkah – langkahnya sebagai berikut :

Pertama kita buka lembar kerja excel  kemudian seperti biasa kita masuk di VBA Property dengan dengan menggunakan tombol pintasan di keyboard anda

ALT + F11

Setelah tampil jendela vba propertinya buatlah

1 buah Userform
1 buah Cammadbuton
          Untuk tombo exit
1 buah label
            Untuk menampilkan tulisan berjalan pada userform

Yang semuanya sudah dibuat dan  dimodif sedemikian rupa sehingga tampil indah sesuai pilihan warna selera anda

Pada userform pastekan kode macro berikut

Dim Berhenti As Boolean
Private Sub UserForm_Initialize()
    With Application
        .WindowState = xlMaximized
        Zoom = Int(.Width / Me.Width * 100)
        Width = .Width
        Height = .Height
    End With
End Sub

Private Sub UserForm_Activate()
    Call Mulai
    End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Berhenti = True
     If CloseMode = 0 Then
Cancel = True
MsgBox "Untuk  Menutup Form silakan klik tombol Masuk", vbCritical
End If
End Sub

Private Sub Mulai()
    Dim j As Long
   
Awal:
    DoEvents
    If Berhenti = True Then Exit Sub
    Label9.Left = Label9.Left - 2
    If Label9.Left <= -Me.Width Then Label9.Left = Me.Width
      For j = 1 To 6543210: Next
    GoTo Awal
End Sub

Private Sub CommandButton1_Click()
Unload Me
Sheets("Sheet1").Select
End Sub

Pada modul pastekan kode berikut :

Sub fulldekstop()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
End Sub

Selesai
Silahkan dipraktekan di lembar kerja anda
Semoga bermanfaat

Dapatkan tutorial lansung belajar vba dari awal sampai mahir melalu kontak dengan buku panduan  Paket Belajar vba lengkap  

PUTU ASANA
Wa . 082 396 256 527

Sampel file Userform full desktop dapat di unduh pada link berikut ini

Form Edit dgn Combobox

FORM EDIT SEDERHANA
Pembahasan Kali adalah cara membuat form edit sederhana menggunakan combobox sebagai control pencariannya
Buatlah Form seperti gambar diatas
ComboBox1 , TextBox2 dan TextBox3 dan CommandButton1
Sebuah sheet denga Nama “ Petani “
Cara cukup Mudah Pastekan kode berikut pada CommandButton1
Kode lengkapnya :

Private Sub CommandButton1_Click()
Dim pesan As Integer
pesan = MsgBox("Yakin ingin menyimpan Data PETANI baris ini?", vbYesNo + vbQuestion, "Peringatan")
If pesan = vbYes Then
Data = ComboBox1.Value
With Worksheets("PETANI").Range("A6:A58")
Set c = .Find(Data, LookIn:=xlValues)
If Not c Is Nothing Then
baris = c.Row
Worksheets("PETANI").Cells(baris, 1).Value = ComboBox1.Value
Worksheets("PETANI").Cells(baris, 2).Value = TextBox2.Value
Worksheets("PETANI").Cells(baris, 3).Value = TextBox3.Value
End If
End With
ComboBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
ComboBox1.SetFocus
End If
End Sub


Pastekan Kode untuk menampilkan list pada combox1 pada userform1  kode lengkap dibawah ini  :

Private Sub UserForm_Initialize()
ComboBox1.List = Sheets("PETANI").Range("a6:a200").Value
End Sub

Seperti biasanya buat modul untuk memanggil userform
Dengan kode sebagai berikut

Sub panggil_userform1 ()
Userform1. Show
End sub

Selesai
Semoga bermanfaat
Silahkan klik halaman Download dibawah ini


 Form Edit 

Combobox Multy list

               Combobox List

Beragam cara yang digunakan dalam menampilkan data pada Combobox baik pada userfrom yang menggunakan 1 combobox atau Multy Combobox
Berikut Pilihan yang dapat dipastekan pada Userform

1. List dengan data Horisontal

Private Sub UserForm_Initialize()
ComboBox1.List = Application.Transpose(Sheet1.Range("D5:P5").Value)
End Sub

2. List dengan AddItem

Private Sub UserForm_Initialize()
ComboBox2.AddItem "GANJIL"
ComboBox2.AddItem "GENAP"
end sub

3. List dengan data Sheet

Private Sub UserForm_Initialize()
ComboBox3.List = Sheet1.Range("B5:B20").Value
End Sub



4.List Combobox   (sesuai data  1 kolom)

Private Sub UserForm_Initialize()
For Jmlh = 3 To 12
Nilai = Range("L" & Jmlh)
ComboBox1.AddItem Nilai
Next Jmlh
End Sub

5,List Multi Combobox   (sheet data  multy  kolom)

Private Sub UserForm_Initialize()
For Jmlh = 1To 10
Tanggal = Range("A" & Jmlh)
Bulan = Range("B" & Jmlh)
Tahun = Range("C" & Jmlh)
Pasien = Range("D" & Jmlh)
ComboBox1.AddItem Tanggal
ComboBox2.AddItem Bulan
ComboBox3.AddItem Tahun
Next Jmlh
End Sub

6.  List dengan data Filter

Dengan List  data Filter data kolom yang menjadi acuan akan difilter otomatis dan menampilkan item bila ada data yang sama atau ganda
Kode Lengkapnya sebagai berikut

Dim Tbl As Range
Private Sub UserForm_Initialize()
   Dim Cabang As Range, UniqCabang, n As Long
   Set Tbl = Sheets("Sheet1").Cells(4, 1).CurrentRegion
   Set Cabang = Tbl.Offset(2, 1).Resize(Tbl.Rows.Count - 2, 1)
   UniqCabang = LOUV(Cabang)
   ComboBox1.Clear
   For n = LBound(UniqCabang) To UBound(UniqCabang)
      ComboBox1.AddItem UniqCabang(n)
   Next n
End Sub

Dapat ditulis Mode multy list lengkap dalam 1 userform berikut cara penulisannya

Private Sub UserForm_Initialize()
For Jmlh = 1 To 10
Tanggal = Range("A" & Jmlh)
Bulan = Range("B" & Jmlh)
Tahun = Range("C" & Jmlh)
Pasien = Range("D" & Jmlh)
ComboBox1.AddItem Tanggal
ComboBox2.AddItem Bulan
ComboBox3.AddItem Tahun
Next Jmlh
ComboBox4.List = Sheet1.Range("E1:E10").Value
ComboBox5.AddItem "GANJIL"
ComboBox5.AddItem "GENAP"
ComboBox6.List = Application.Transpose(Sheet1.Range("D5:P5").Value)
End Sub



selesai
Semoga bermanfaat

Silahkan klik halaman Download dibawah ini


 Combobox List

Dapatka Buku Pintar full VBA

 Cover Buku Pintar 

Cari data dengan Tombol Buton

          Form pencarian data

Membuat Form Pencarian data dengan tombol Command Buton
Dengan properties yang dipersiapkan adalah

Name : UserForm1 dan 
Label Palin atas  dengan Caption  Tampilkan data”

Tambahkan tool-tool dengan properties sebagai berikut :
CommandButton1  dengan Caption : cari
CommandButton2  dengan Caption : Cancel
Texbox1 , Texbox2 dan Combobox1

Label 1  dengan Caption Kode Produk
Label 2  dengan Caption Nama Produk
Label 3  dengan Caption Harga Satuan

Kode pada CommandButton1 adalah

Private Sub CommandButton1_Click()
cari = ComboBox1.Value
With Worksheets("Sheet1").Range("b6:b58")
Set c = .Find(cari, LookIn:=xlValues)
If Not c Is Nothing Then
baris = c.Row
TextBox1.Value = Worksheets("Sheet1").Cells(baris, 3).Value
TextBox2.Value = Worksheets("Sheet1").Cells(baris, 4).Value
Else
MsgBox "MAAF data TIDAK DITEMUAKAN"
End If
End With
End Sub

Kode pada CommandButton2 adalah

Private Sub CommandButton2_Click()
Unload Me
End Sub

Modul untuk memanggil userform

Sub tambahdata()
UserTampil.Show
End Sub

Kode untuk mengisi list pada Combobox

Private Sub UserForm_Initialize()
ComboBox1.List = Sheets("Sheet1").Range("b6:b200").Value
End Sub

Save As File Excel dengan format Excel Macro-Enabeled Workbook supaya hasil yang VBA macro tidak hilang
Demikian postingan singkat kali ini semoga bermanfaat
Selesai.
Untuk file yang sudah jadi sebagai bahan latihan bisa sobat download pada link dibawah ini




 Form Cari Tombol Buton 

Cari Data dgn Combobox

Selamat berinovasi sobat Belajar Office dan tetap bersemangat untuk beraktivitas kembali. Pada kesempatan ini admin akan membahas cara membuat

Form Pencarian data pada Excel VBA sederhana  dilengkapi dengan koding simpel dulu sehingga lebih mudah untuk dipahami
dengan menggunakan Combobox sebagai Control pencarian

Dengan mengetik kode pada combobox maka data otomatis akan tampil pada texbox 

Prosedur yang digunakan adalah

Private Sub ComboBox1_Change()

yang mana saat ComboBox di klik kode otomatis akan berjalan

Langkah-langkahnya sangat mudah yaitu sebagai berikut :
Buka MS Excel buatlah dua buah sheet : Sheet1 dan Sheet2

Buat userform baru yang simpel dulu dengan tampilan seperti contoh gambar diatas

Dengan properti

Name : UserForm1 dan 
Label Paling atas  dengan Caption  Form Tampilkan Data”
Tambahkan tool-tool dengan properties sebagai berikut :

CommandButton1  dengan Caption : Cancel

Label 1  dengan Caption Kode Produk
Label 2  dengan Caption Nama Produk
Label 3  dengan Caption Harga Satuan
Texbox1  dan Texbox2 dan Combobox1

Selanjutnya untuk koding Cancel (untuk menutup form jika data tidak jadi di input)
Koding untuk combobox1 adalah

Private Sub ComboBox1_Change()
Set CC = Sheets("Sheet1")
On Error Resume Next 'meski error lanjut terus
Set KunciLook = CC.Range("b6", CC.Range("b6").End(xlDown))
Set c = KunciLook.Find(ComboBox1.Value, LookIn:=xlValues, MatchCase:=False)
TextBox1.Value = c.Offset(0, 1).Value
TextBox2.Value = c.Offset(0, 2).Value
TextBox3.Value = c.Offset(0, 3).Value
End Sub

Doubel Klik pada Tool CommandButton1 atau tombol Cancel ketikan kodingnnya seperti dibawah ini

Private Sub CommandButton2_Click()
Unload Me
End Sub

Kemudia untuk mengisi otomatis kode combobox  dengan list kolom yang sudah ditentukan dengan kode
Private Sub UserForm_Initialize()
Berikut pastekan code lengkapnya berikut di userform1

Private Sub UserForm_Initialize()
ComboBox1.List = Sheets("Sheet1").Range("b6:b200").Value
End Sub

Selanjutnya kita buat tombol pada sheet1 untuk menampilkan atau memanggil userform input data yang telah kita buat dengan sebuah gambar atau shape yang akan menuju modulyang akan memanggil userform1

Buatlah sebuah modul pada property vba dengan cara
Klik ALT + F11 Kemudian Insert Modul dan pastekan kode berikut

Sub Panggil ()
Userform1. Show
End sub

Save As File Excel dengan format Excel Macro-Enabeled Workbook supaya hasil yang VBA macro tidak hilang
Demikian postingan singkat kali ini semoga bermanfaat
Selesai.