SALAM PEMBUKA

  • ASSALAMU 'ALAIKUM WAROHMATULLAHI WABAROKATUH
Tampilkan postingan dengan label VBA EXCEL. Tampilkan semua postingan
Tampilkan postingan dengan label VBA EXCEL. Tampilkan semua postingan

Jumat, 21 April 2017

Macam Macam Cara Mencari Data

1. pencarian dengan menggunakan textbox1 dan di tampilkan di textbox lain
Private Sub TextBox1_Change()
Set Macro = Sheets("Sheet1")
On Error Resume Next
Set EditMacro = Macro.Range("A3Kebawah")
Set c = EditMacro.Find(TextBox1.Value, _
LookIn:=xlValues)
TextBox2.Value = c.Offset(0, 1).Value
TextBox3.Value = c.Offset(0, 2).Value
TextBox4.Value = c.Offset(0, 3).Value
End Sub

2. Pencarian bagian 2
Input data berdasarkan kolom pencarian 1
Dim Kode
Dim CellTujuan As Range
Kode = TextBox1.Value
Set CellTujuan = Range("C3:ZZ3").Find(What:=Kode,
LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
TextBox2 = Cells(4, CellTujuan.Column)
End If


3. Pencarian bagian 3
Dim x As Range
For Each x In Range("A1:Z100")
If x.Value = CStr(TextBox1.Value) Then
TextBox2.Value = x.Offset(1, 0).Value
End If
Next

4. pencarian pada 3 sheet
Mencari data 3 sheet
Private Sub TextBox2_Change()
Dim i As integer
For i = 1 to 3
Set IpAoNE = Sheets("Sheet"&i)
Set IdRangeA = IpAoNE.Range("B3:B8")
Set c = IdRangeA.Find(TextBox1.Value,
LookIn:=xlValues)
TextBox2.Value = c.Offset(0, 1).Value
TextBox3.Value = c.Offset(0, 2).Value
Next i
End Sub
28.04.2017
*********(((
PENGEMBANGN
3 sheet
Bulanjanuari, bulanpebruari, Bulanmei
Dim i As integer
Dim 1, 2, 3
1 = Januari
2 = pebruari
3 = maret
For i = 1 to 3
Set IpAoNE = Sheets("bulan"&i)
Set IdRangeA = IpAoNE.Range("B3:B8")
Set c = IdRangeA.Find(TextBox2.Value,
LookIn:=xlValues, _
MatchCase:=False)
TextBox1.Value = c.Offset(0, -1).Value
TextBox3.Value = c.Offset(0, 1).Value
Next i
End Sub

Jumat, 31 Maret 2017

Cara memasukkan isi listbox ke textbox beda userform

Untuk menampilkan userform3 dan mengisi textbox dari listbox yg di userform1
Di tulis dalam event doble clik listbox

Privat sub listCaridblclik
if listCari.listindex < 0 then exit sub
Userform3.Textbox1 = listCari. List (listCari. Listindex, 0)
Userform3.show
End sub

Jumat, 24 Maret 2017

Menghapus data terpilih dalam listbox

Private Sub CommandButton2_Click()
'perintah untuk menghapus data Terpilih dari dalam ListBox2

Dim counter As Integer
counter = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i - counter) Then
ListBox2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub

Jumat, 17 Maret 2017

cara menggunakan kode Penjumlahan pada listbox

cara menggunakan kode Penjumlahan pada listbox

Private Sub totalharga()
Dim i As Integer
Dim harga As Long
harga = 0
For i = 0 To ListBox1.ListCount - 1
harga = harga + Val(ListBox1.List(i, 2))
Next
Me.txtotal.Text = harga
End Sub
 
Penjumlahan list box2
Sub hitung ()
With listbox1
Me.TxtTotal=0
For i =1 to. ListCount - 1
Me.TxtTotal = csng (me.txtTotal) + csng (. List (i, 4))
Next
End with
End sub

Jumat, 10 Maret 2017

Cara Memberi Nama Header / Kepala Kolom

Cara Memberi Nama Header / Kepala Kolom
Sub Headerlist()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Nomor"
.List(.ListCount - 1, 1) = "Nama Siswa"
.List(.ListCount - 1, 2) = "Kelas"
.List(.ListCount - 1, 3) = "Wali murid"
.ColumnWidths = 35 & ";" & 70 & ";" & 45 & ";" & 80
End With
End Sub

Jumat, 03 Maret 2017

Macam Macam fungsi Listview

macam macam fungsi listview

1. Menampilkan Data pada TextBox saat data diKlik pada
ListView
Private Sub ListView1_ItemClick(ByVal Item As
MSComctlLib.ListItem)
TextBox1 = ListView1.SelectedItem
TextBox2 = ListView1.SelectedItem.SubItems(1)
TextBox3 = ListView1.SelectedItem.SubItems(2)
TextBox4 = ListView1.SelectedItem.SubItems(3)
TextBox5 = ListView1.SelectedItem.SubItems(4)
End Sub


2. Memberikan Judul pada ListView
Private Sub UserForm_Initialize()
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:="Tanggal Transaksi", Width:=100
.ColumnHeaders.Add Text:="Nama Produk", Width:=170
.ColumnHeaders.Add Text:="Satuan", Width:=60
.ColumnHeaders.Add Text:="Jumlah", Width:=40
.ColumnHeaders.Add Text:="Total Harga", Width:=100
End With
Call Tampil
End Sub


3. Menampilkan data dari Worksheet Excell ke dalam
ListView
Sub Tampil()
Dim Item As ListItem
Dim rekamandata As Integer
Dim i As Integer
ListView1.ListItems.Clear
rekamandata = Sheet1.Cells(Rows.Count, 1).End
(xlUp).Row
For i = 4 To rekamandata
Set Item = ListView1.ListItems.Add(Text:=Sheet1.Cells(i,
1))
Item.SubItems(1) = Sheet1.Cells(i, 2)
Item.SubItems(2) = Sheet1.Cells(i, 3)
Item.SubItems(3) = Sheet1.Cells(i, 4)
Item.SubItems(4) = Sheet1.Cells(i, 5)
Next
Label1.Caption = ListView1.ListItems.Count 'Menghitung
Data Dalam ListView
End Sub

Jumat, 24 Februari 2017

CARA memasukkan data TextBox Ke dalam ListBox

memasukkan data TextBox Ke dalam ListBox
Private Sub CommandButton1_Click()
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = TextBox1.Value
.List(.ListCount - 1, 1) = TextBox2.Value
.List(.ListCount - 1, 2) = TextBox3.Value
.List(.ListCount - 1, 3) = TextBox4.Value
End With
End Sub

Jumat, 17 Februari 2017

Cara memasukan isi List Box ke Textbox pada Vba excel.

ini merupakan kode Cara memasukan isi List Box ke Textbox
pada Vba excel.

Private Sub listBox1_Click()
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub

Private Sub listBox1_Click()
'masukan teks dalam listbox kolom pertama ke dalam
texbox1
TextBox1.Value = Listbox1.List(listBox1.ListIndex, 1)
'masukan teks dalam listbox kolom kedua ke dalam
texbox2
TextBox2.Value = Listbox1.List(listBox1.ListIndex, 2)
'masukan teks dalam listbox kolom ketiga ke dalam
texbox3
TextBox3.Value = Listbox1.List(listBox1.ListIndex, 3)
End Sub

Jumat, 10 Februari 2017

Menampilkan Data Worksheet Ke dalam ListBox

Menampilkan Data Worksheet Ke dalam ListBox
Sub TampilkanSemua()
Set wsDtbsPlgn = Sheets("Data")
ListBox1.Clear
ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = 80 & ";" & 25 & ";" &
35 & ";" & 65 & ";" & 120
Set rgTampil = wsDtbsPlgn.Range
("A1:A100").SpecialCells(xlCellTypeVisible)
For Each i In rgTampil
With ListBox1
.AddItem
.List(.ListCount - 1, 0) = i.Value
.List(.ListCount - 1, 1) = i.Offset(0, 1).Value
.List(.ListCount - 1, 2) = i.Offset(0, 2).Value
.List(.ListCount - 1, 3) = i.Offset(0, 3).Value
.List(.ListCount - 1, 4) = i.Offset(0, 4).Value
End With
Next i
End Sub

Jumat, 03 Februari 2017

MACAM MACAM INPUT DATA VBA EXCEL

MACAM MACAM INPUT DATA VBA EXCEL

1. Input data hanya 1 sheet

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(“Barang”)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB


2. input data berayarat manual sesuai nama sheet
yaitu tambahkan kode pada tombo pesan
Private Sub CommandButton1_Click()
Set ws = Worksheets("BUAH")
Set ws2 = Worksheets("KUE")
Set ws3 = Worksheets("PERMEN")
Set ws4 = Worksheets("NASI")

'menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow2 = ws2.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow3 = ws3.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
iRow4 = ws4.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check untuk sebuah kode
If Trim(Me.TextBox1.Value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Masukan Kode Pembeli"
Exit Sub
End If
'copy data ke database
If ComboBox1.Value = "BUAH" Then
With ws
ws.Cells(iRow, 1).Value = Me.TextBox1.Value
ws.Cells(iRow, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "KUE" Then
With ws2
ws2.Cells(iRow2, 1).Value = Me.TextBox1.Value
ws2.Cells(iRow2, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "PERMEN" Then
With ws3
ws3.Cells(iRow3, 1).Value = Me.TextBox1.Value
ws3.Cells(iRow3, 2).Value = Me.TextBox2.Value
End With
ElseIf ComboBox1.Value = "NASI" Then
With ws
ws4.Cells(iRow4, 1).Value = Me.TextBox1.Value
ws4.Cells(iRow4, 2).Value = Me.TextBox2.Value
End With

End If

'clear data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""
Me.TextBox1.SetFocus
MsgBox "DATA TELAH DI SIMPAN"
End Sub

3.A. Input data berdasarkan kolom pencarian 1
Dim Kode
Dim CellTujuan As Range
Kode = TextBox1.Value
Set CellTujuan = Range("C3:ZZ3").Find(What:=Kode,
LookIn:=xlValues, LookAt:=xlWhole)
If Not CellTujuan Is Nothing Then
TextBox2 = Cells(4, CellTujuan.Column)
End If
iRow = ws.Cells(Rows.Count, CellTujuan.Column) _
.End(xlUp).Offset(1, CellTujuan.Column).Row
ws.Cells(iRow, CellTujuan.Column).Value = Textbox2.Value

3.B.Input data berdasarkan kolom pencarian 2
Dim x As Range
For Each x In Range("A1:Z100")
If x.Value = CStr(TextBox1.Value) Then
TextBox2.Value = x.Offset(1, 0).Value
End If
Next
iRow = ws.Cells(Rows.Count, x.Column) _
.End(xlUp).Offset(1, x.Column).Row
ws.Cells(iRow, x.Column).Value = Textbox2.Value

4. Input data KEDALAM SHEET, NAMA SHEET SESUAI TEXTBOX

Dim iRow As Long
Dim ws As Worksheet
nama = TextBulan.value
Set ws = Worksheets(nama)
‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
‘check untuk sebuah kode
If Trim(TextBox1.Value) = “” Then
TextBox1.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If
‘copy data ke database
ws.Cells(iRow, 1).Value = TextBox1.Value
ws.Cells(iRow, 2).Value = TextBox2.Value
ws.Cells(iRow, 3).Value = TextBox3.Value
ws.Cells(iRow, 4).Value = TextBox4.Value
‘clear data
TextBox1.Value = “”
TextBox2.Value = “”
TextBox3.Value = “”
TextBox4.Value = “”
TextBox1.SetFocus
END SUB