MEMBUAT USERFORM INPUT SEDERHANA -EXCEL VBA

Pastekan pada CommandButton1

Private Sub CommandButton1_Click()

Dim irow As Long

irow = Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row

Worksheets("sheet1").Cells(irow, 2).Value = TextBox1.Value

Worksheets("sheet1").Cells(irow, 3).Value = TextBox2.Value

Sheets("sheet1").Range("a1") = Application.CountA(Range("b5:b20"))

No = 0

For NOMOR = 1 To Range("a1")

No = No + 1

Cells(No + 4, 1).Value = No

Next NOMOR

End Sub

Pastekan pada Userform

Private Sub UserForm_Initialize()

 ListBox1.ColumnCount = 3

 ListBox1.ColumnWidths = 50 & ";" & 100 & ";" & 150

 ListBox1.RowSource = "data"

End Sub

Cara Mudah Membuat form Input Dengan Memilih Satu Atau lebih Pilihan Sheet Yang Akan Di Input

Pengaturan Tampilan Pada property listbok 
yakni pastikan multyselect bernilai 1

PASTEKAN KODE BERIKUT PADA TOMBOL TAMBAH

Private Sub CommandButton1_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
Dim iRow As Long
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

    Range("A1") = Application.CountA(Range("c6:c100"))
    No = 0
    For NOMOR = 1 To Range("A1")
    No = No + 1
    Cells(No + 5, 1).Value = No
    Next NOMOR
    End Sub

PASTEKAN KODE BERIKUT PADA USERFORM

Private Sub UserForm_Initialize()
 For k = 1 To Sheets.Count
        ListBox1.AddItem Sheets(k).Name
    Next
Label1.Caption = Cells(5, 2).Value
Label2.Caption = Cells(5, 3).Value
Label3.Caption = Cells(5, 4).Value
Label4.Caption = Cells(5, 5).Value
Label5.Caption = Cells(5, 6).Value
End Sub

 UNDUH SAMPEL FILE xlsm >>>>>    disini

semoga bermanfaat

Cara Mudah Membuat form Input Ke Satu Pilihan Sheet Di Excel

Pengaturan Tampilan Pada property listbok yakni pastikan multyselect bernilai 0

PASTEKAN KODE BERIKUT PADA TOMBOL TAMBAH

Private Sub CommandButton1_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
Dim iRow As Long
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

    Range("A1") = Application.CountA(Range("c6:c100"))
    No = 0
    For NOMOR = 1 To Range("A1")
    No = No + 1
    Cells(No + 5, 1).Value = No
    Next NOMOR
    End Sub

PASTEKAN KODE BERIKUT PADA USERFORM

Private Sub UserForm_Initialize()
 For k = 1 To Sheets.Count
        ListBox1.AddItem Sheets(k).Name
    Next
Label1.Caption = Cells(5, 2).Value
Label2.Caption = Cells(5, 3).Value
Label3.Caption = Cells(5, 4).Value
Label4.Caption = Cells(5, 5).Value
Label5.Caption = Cells(5, 6).Value
End Sub

Cara Mudah Membuat Form Input dengan Chexbox

Cara Mudah Membuat Form Input dengan Chexbox

Kode input

Pastekan pada CommandButton1

Private Sub CommandButton1_Click()

Dim irow As Long

irow = Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row

Worksheets("sheet1").Cells(irow, 2).Value = TextBox1.Value

Worksheets("sheet1").Cells(irow, 3).Value = TextBox2.Value

Worksheets("sheet1").Cells(irow, 4).Value = TextBox3.Value

If CheckBox1.Value = True Then Cells(irow, 5).Value = CheckBox1.Caption

If CheckBox2.Value = True Then Cells(irow, 6).Value = CheckBox2.Caption

If CheckBox3.Value = True Then Cells(irow, 7).Value = CheckBox3.Caption

End If

End Su

Unduh sampel file xlsm >>>> disini


Demikian semoga bermanfaat dan dapat menjadi inpirasi dan inovasi !!

Form Input dengan Option Button - EXCEL VBA

Pastekan kode berikut pada tombol tambah

Private Sub CommandButton1_Click()

Dim Arow As Long

'Deklarasi  arow  input atau mengisi  baris terakhir pada sheet1

Arow = Worksheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row

Worksheets("sheet1").Cells(Arow, 2).Value = TextBox1.Value

Worksheets("sheet1").Cells(Arow, 4).Value = TextBox3.Value

‘True artinya dipilih atau di klik

‘Jika OptionButton1 di klik

If OptionButton1.Value = True Then

Worksheets("sheet1").Cells(Arow, 3).Value = "Pegawai"

‘Jika OptionButton2 di klik

ElseIf OptionButton2.Value = True Then

Worksheets("sheet1").Cells(Arow, 3).Value = "Pengusaha"

‘Jika OptionButton3 di klik

ElseIf OptionButton3.Value = True Then

Worksheets("sheet1").Cells(Arow, 3).Value = "Karyawan"

Else

End If

End Sub

Unduh Sampel file xlsm >>>>   disini

Input data Transpose

Buatlah sebuah modul tombol panggil modul

pastekan kode ini pada modul tersebut :

Sub Copy_transpose_kebaris_terakhir()

Set salin = Sheets("Sheet1").Range("B6:B15")

Set SIMPAN = Sheets("Sheet2").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0)

salin.Copy

SIMPAN.PasteSpecial Transpose:=True

End Sub

sampel file xlsm silakan unduh :
Input Transpose

FORM INPUT VBA MENOLAK DATA DUPLIKAT

Kadang kita akan menginput data namun syaratnya bila nama atau data yang dimaksud sudah terimput  maka sistem akan akan memberi pesan bahwa data tersebut sudah ada

Private Sub CommandButton1_Click()

With Sheets("Sheet1").Range("b6:b50")

Set c = .Find(TextBox1.Value, LookIn:=xlValues)

If c Is Nothing Then

Dim irow As Long

irow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row

Worksheets("Sheet1").Cells(irow, 2).Value = TextBox1.Value

Worksheets("Sheet1").Cells(irow, 3).Value = TextBox2.Value

Worksheets("Sheet1").Cells(irow, 4).Value = TextBox3.Value

Worksheets("Sheet1").Cells(irow, 5).Value = TextBox4.Value

Else

  MsgBox "Maaf Nama Sudah Ada !", vbCritical

  TextBox1.Value = ""

Exit Sub

End If

End With

End Sub

sampel file dapat di unduh pada tautan dibawah ini:

disable data duplicate

Form Input Edit Baris.xlsm

‘Menampilkan data baris melalue combobox

Private Sub ComboBox1_Change()

Cari = ComboBox1.Value

With Worksheets("Sheet1").Range("B6:B50")

Set c = .Find(Cari, LookIn:=xlValues)

If Not c Is Nothing Then

baris = c.Row

'Menampilkan data "ISIAN "

TextBox1.Value = Worksheets("Sheet1").Cells(baris, 3).Value

TextBox2.Value = Worksheets("Sheet1").Cells(baris, 4).Value

Else

MsgBox "nama belum tercantum"

End If

End With

End Sub

Kode input untuk mengedit data baris pilihan

Private Sub CommandButton1_Click()

Data = ComboBox1.Value

With Worksheets("Sheet1").Range("B6:B58")

Set c = .Find(Data, LookIn:=xlValues)

If Not c Is Nothing Then

baris = c.Row

Worksheets("Sheet1").Cells(baris, 3).Value = TextBox1.Value

Worksheets("Sheet1").Cells(baris, 4).Value = TextBox2.Value

End If

End With

TextBox1.Value = ""

TextBox2.Value = ""

ComboBox1.SetFocus

End Sub

Input form ke Tabel Hurup

Pastekan Kode Pada CommandButton1

           

Private Sub CommandButton1_Click()

Sheet1.Activate

Cells(6, 4).Value = ComboBox1.Value

Cells(7, 4).Value = TextBox1.Value

Cells(8, 4).Value = TextBox2.Value

Cells(9, 4).Value = TextBox3.Value

Cells(10, 4).Value = TextBox4.Value

Cells(11, 4).Value = TextBox5.Value

Cells(12, 4).Value = TextBox6.Value

Cells(13, 4).Value = TextBox7.Value

Cells(14, 4).Value = TextBox8.Value

Cells(14, 4).Value = TextBox8.Value

End Sub

‘Menampilkan data pilihan ComboBox1

Private Sub ComboBox1_Change()

Cari = ComboBox1.Value

With Worksheets("Sheet2").Range("B6:B50")

Set c = .Find(Cari, LookIn:=xlValues)

If Not c Is Nothing Then

Baris = c.row

'Menampilkan data "ISIAN "

TextBox1.Value = Worksheets("Sheet2").Cells(Baris, 3).Value

TextBox2.Value = Worksheets("Sheet2").Cells(Baris, 4).Value

TextBox3.Value = Worksheets("Sheet2").Cells(Baris, 5).Value

TextBox4.Value = Worksheets("Sheet2").Cells(Baris, 6).Value

TextBox5.Value = Worksheets("Sheet2").Cells(Baris, 7).Value

TextBox6.Value = Worksheets("Sheet2").Cells(Baris, 8).Value

TextBox7.Value = Worksheets("Sheet2").Cells(Baris, 9).Value

TextBox8.Value = Worksheets("Sheet2").Cells(Baris, 10).Value

Else

MsgBox "Nama Belum terdaftar"

End If

End With

End Sub

Rumus yang digunakan 

=MID($D$6,COLUMNS($D:D),1)                                                         =MID($D$6,COLUMNS($D:f),1) 

=MID($D$6,COLUMNS($D:g),1) 

=MID($D$6,COLUMNS($D:g),1)

UNDUH SAMPEL FILE XLSM  >>>  DISINI

Input Form Pilihan Tabel Kolom

Input  ketabel pilihan dengan Combobox1 sebagai kunci pilihan ke table Kolom

 

Kode input pastekan di CommandButton1

Private Sub CommandButton1_Click()

If ComboBox1.Text = "Tabel1" Then

Dim iRow As Long

Sheets("Sheet1").Activate

iRow = WorksheetFunction.CountA(Range("b6:b50")) + 6

‘dimulai baris ke 6 kolom ke 2

Cells(iRow, 2).Value = TextBox1.Value

Cells(iRow, 3).Value = TextBox2.Value

Cells(iRow, 4).Value = TextBox3.Value

Cells(iRow, 5).Value = TextBox4.Value

ElseIf ComboBox1.Text = "Tabel2" Then

Dim aRow As Long

Sheets("Sheet1").Activate

aRow = WorksheetFunction.CountA(Range("g6:g50")) + 6

‘dimulai baris ke 6 kolom ke 7

Cells(aRow, 7).Value = TextBox1.Value

Cells(aRow, 8).Value = TextBox2.Value

Cells(aRow, 9).Value = TextBox3.Value

Cells(aRow, 10).Value = TextBox4.Value

ElseIf ComboBox1.Text = "Tabel3" Then

Dim cRow As Long

Sheets("Sheet1").Activate

cRow = WorksheetFunction.CountA(Range("L6:L50")) + 6

‘dimulai baris ke 6 kolom ke 12

Cells(cRow, 12).Value = TextBox1.Value

Cells(cRow, 13).Value = TextBox2.Value

Cells(cRow, 14).Value = TextBox3.Value

Cells(cRow, 15).Value = TextBox4.Value

End If

End Sub

Private Sub UserForm_Initialize()

ComboBox1.AddItem "Tabel1"

ComboBox1.AddItem "Tabel2"

ComboBox1.AddItem "Tabel3"

End Sub

Baca Juga :
- Input Data dan Foto
- USERFORM INPUT DATA SEDERHANA
- EDIT DATA SEDERHANA

MEMBUAT USERFORM INPUT KASIR SEDERHANA

MEMBUAT USERFORM INPUT KASIR SEDERHANA

Pastekan pada ComboBox1

Private Sub ComboBox1_Change()

Set PELANGGAN = Sheets("PELANGGAN")

On Error Resume Next 'meski error lanjut terus

Set KunciLook = PELANGGAN.Range("B3", PELANGGAN.Range("B3").End(xlDown))

Set c = KunciLook.Find(ComboBox1.Value, LookIn:=xlValues, MatchCase:=False)

TextBox1.Value = c.Offset(0, 1).Value

Dim dDate As Date

dDate = DateSerial(Year(Date), Month(Date), Day(Date))

TextBox6.Value = Format(TextBox6.Value, "dd/mm/yyyy")

dDate = TextBox6.Value

End Sub

Pastekan pada ComboBox2

Private Sub ComboBox2_Change()

Set BARANG = Sheets("PELANGGAN")

On Error Resume Next 'meski error lanjut terus

Set KunciLook = BARANG.Range("D3", BARANG.Range("D3").End(xlDown))

Set c = KunciLook.Find(ComboBox2.Value, LookIn:=xlValues, MatchCase:=False)

TextBox2.Value = c.Offset(0, 1).Value

TextBox3.Value = c.Offset(0, 2).Value

End Sub

Pastekan pada CommandButton1

Private Sub CommandButton1_Click()

'kode input

Dim irow As Long

irow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row

Worksheets("Sheet1").Cells(irow, 2).Value = TextBox6.Value

Worksheets("Sheet1").Cells(irow, 3).Value = ComboBox1.Value

Worksheets("Sheet1").Cells(irow, 4).Value = TextBox1.Value

Worksheets("Sheet1").Cells(irow, 5).Value = ComboBox2.Value

Worksheets("Sheet1").Cells(irow, 6).Value = TextBox2.Value

Worksheets("Sheet1").Cells(irow, 7).Value = TextBox4.Value

Worksheets("Sheet1").Cells(irow, 8).Value = TextBox3.Value

Worksheets("Sheet1").Cells(irow, 9).Value = TextBox5.Value

End Sub

Pastekan pada TextBox4

Private Sub TextBox4_Change()

a = Val(TextBox3.Text)

b = Val(TextBox4.Text)

r = a * b

TextBox5.Text = r

End Sub

Pastekan pada TextBox8

Private Sub TextBox8_Change()

a = Val(TextBox5.Text)

b = Val(TextBox8.Text)

r = b - a

TextBox7.Text = r

End Sub

Pastekan pada UserForm

Private Sub UserForm_Initialize()

ComboBox1.List = Sheets("PELANGGAN").Range("B3:B25").Value

ComboBox2.List = Sheets("PELANGGAN").Range("D3:D50").Value

TextBox6.Value = Sheets("PELANGGAN").Range("a1").Value

TextBox6.Value = Format(TextBox6.Value, "dd/mm/yyyy")

ListBox1.ColumnCount = 9

ListBox1.ColumnWidths = 20 & ";" & 0 & ";" & 0 & ";" & 110 & ";" & 0 & ";" & 110 & ";" & 20 & ";" & 0 & ";" & 50

ListBox1.RowSource = "DAfTAR"

End Sub

Download file sampel silahkan unduh : Disini