userform arama sonrası listbox verileri yazdırma butonu ?

Verilerinizi listeleyebileceğiniz liste kutusu

userform arama sonrası listbox verileri yazdırma butonu ?

İleti#1)  fmceyhan25 » 06 Nis 2018 10:22

merhaba kolay gelsin ek'te yüklediğim resime istinaden arama kısmından ara yaptığım zaman gelen kayıtları nasıl düzenli bir şekilde yatay şekilde yazdırabilirim. listbox içindeki atıyorum 39 tane kısım var bunlardan ilk 10 unu yazdıracağım arama yaptığım sonuca göre kodlarıda ek'te sundum yardımcı olanlara şimdiden teşekkürler. şkşk

excel vba kodlar;

Kod: Tümünü seç
Private Sub Cmdbutton1_Click()
If TextBox50 = 0 Then
Exit Sub
End If
If ListBox1.ListIndex = 0 Then
MsgBox "Liste Kutusunda İlk Kayıt", vbCritical
Exit Sub
Else
TextBox50 = TextBox50 - 1
With Me.ListBox1
        .ListIndex = .ListIndex - 1
End With
End If
End Sub

Private Sub Cmdbutton2_Click()
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then
MsgBox "Liste Kutusunda Son Kayıt", vbCritical
Exit Sub
Else
TextBox50 = TextBox50 + 1
With Me.ListBox1
        .ListIndex = .ListIndex + 1
End With
End If
End Sub

Private Sub Cmdbutton3_Click() 'FIRST RECORD BUTTON
ListBox1.ListIndex = 0
End Sub

Private Sub Cmdbutton4_Click() 'LAST RECORD BUTTON
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    Me.ComboBox1.DropDown
End Sub

Private Sub CommandButton1_Click() 'Saving Button
Dim sonsat As Long

If TextBox1.Value = "" Then
        MsgBox "Lütfen Adı Soyadı Giriniz.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
    If TextBox2.Value = "" Then
        MsgBox "Lütfen Mahalle Adı Giriniz.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
    If TextBox3.Value = "" Then
        MsgBox "Lütfen Cadde/Sokak Giriniz..", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
If TextBox10.Value = "" Then
        MsgBox "Lütfen Evrak Başlığı Giriniz", vbExclamation
        TextBox10.SetFocus
        Exit Sub
    End If
    If TextBox12.Value = "" Then
        MsgBox "Lütfen Telefon Numarası Giriniz.", vbExclamation
        TextBox12.SetFocus
        Exit Sub
    End If
   
'sonsat = Sheets("Data").[a65536].End(3).row + 1
sonsat = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).row + 1
Call Main 'Progress Bar

Cells(sonsat, 1) = TextBox1
Cells(sonsat, 2) = TextBox2
Cells(sonsat, 3) = TextBox3
Cells(sonsat, 4) = TextBox4
Cells(sonsat, 5) = TextBox5
Cells(sonsat, 6) = TextBox6
Cells(sonsat, 7) = TextBox7
Cells(sonsat, 8) = TextBox8
Cells(sonsat, 9) = TextBox9
Cells(sonsat, 10) = TextBox10
Cells(sonsat, 11) = TextBox11
Cells(sonsat, 12) = TextBox12
Cells(sonsat, 13) = TextBox13
Cells(sonsat, 14) = TextBox14
Cells(sonsat, 15) = TextBox15
Cells(sonsat, 16) = TextBox16
Cells(sonsat, 17) = TextBox17
Cells(sonsat, 18) = TextBox18
Cells(sonsat, 19) = TextBox19
Cells(sonsat, 20) = TextBox20
Cells(sonsat, 21) = TextBox21
Cells(sonsat, 22) = TextBox22
Cells(sonsat, 23) = TextBox23
Cells(sonsat, 24) = TextBox24
Cells(sonsat, 25) = TextBox25
Cells(sonsat, 26) = TextBox26
Cells(sonsat, 27) = TextBox27
Cells(sonsat, 28) = TextBox28
Cells(sonsat, 29) = TextBox29
Cells(sonsat, 30) = TextBox30
Cells(sonsat, 31) = TextBox31
Cells(sonsat, 32) = TextBox32
Cells(sonsat, 33) = TextBox33
Cells(sonsat, 34) = TextBox34
Cells(sonsat, 35) = TextBox35
Cells(sonsat, 36) = TextBox36
Cells(sonsat, 37) = TextBox37
Cells(sonsat, 38) = TextBox38
Cells(sonsat, 39) = TextBox39

MsgBox "KAYIT BAŞARILI"
ListBox1.List = Sheets("Data").Range("A2:am" & Cells(Rows.Count, 1).End(xlUp).row).Value 'For refresh listbox
TextBox52.Value = ListBox1.ListCount
End Sub

Private Sub CommandButton2_Click() 'Change Button
Dim sonsat As Long

If ListBox1.ListIndex = -1 Then
MsgBox "Bir Nesne Seçiniz.", vbExclamation
Exit Sub
End If
Sheets("Data").Range("A:A").Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate
sonsat = ActiveCell.row

Cells(sonsat, 1) = TextBox1.Text
Cells(sonsat, 2) = TextBox2.Text
Cells(sonsat, 3) = TextBox3.Text
Cells(sonsat, 4) = TextBox4.Text
Cells(sonsat, 5) = TextBox5.Text
Cells(sonsat, 6) = TextBox6.Text
Cells(sonsat, 7) = TextBox7.Text
Cells(sonsat, 8) = TextBox8.Text
Cells(sonsat, 9) = TextBox9.Text
Cells(sonsat, 10) = TextBox10.Text
Cells(sonsat, 11) = TextBox11.Text
Cells(sonsat, 12) = TextBox12.Text
Cells(sonsat, 13) = TextBox13.Text
Cells(sonsat, 14) = TextBox14.Text
Cells(sonsat, 15) = TextBox15.Text
Cells(sonsat, 16) = TextBox16.Text
Cells(sonsat, 17) = TextBox17.Text
Cells(sonsat, 18) = TextBox18.Text
Cells(sonsat, 19) = TextBox19.Text
Cells(sonsat, 20) = TextBox20.Text
Cells(sonsat, 21) = TextBox21.Text
Cells(sonsat, 22) = TextBox22.Text
Cells(sonsat, 23) = TextBox23.Text
Cells(sonsat, 24) = TextBox24.Text
Cells(sonsat, 25) = TextBox25.Text
Cells(sonsat, 26) = TextBox26.Text
Cells(sonsat, 27) = TextBox27.Text
Cells(sonsat, 28) = TextBox28.Text
Cells(sonsat, 29) = TextBox29.Text
Cells(sonsat, 30) = TextBox30.Text
Cells(sonsat, 31) = TextBox31.Text
Cells(sonsat, 32) = TextBox32.Text
Cells(sonsat, 33) = TextBox33.Text
Cells(sonsat, 34) = TextBox34.Text
Cells(sonsat, 35) = TextBox35.Text
Cells(sonsat, 36) = TextBox36.Text
Cells(sonsat, 37) = TextBox37.Text
Cells(sonsat, 38) = TextBox38.Text
Cells(sonsat, 39) = TextBox39.Text

Call Main 'Progress Bar
MsgBox "KAYIT GÜNCELLENDİ"
ListBox1.List = Sheets("Data").Range("A2:am" & Cells(Rows.Count, 1).End(xlUp).row).Value 'For refresh listbox
End Sub

Private Sub CommandButton3_Click() ' Delete Button
   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
   MsgBox "Bir Giriş Seçiniz", vbExclamation
   Exit Sub
   End If
   If ListBox1.ListIndex >= 0 Then
    cevap = MsgBox("GİRİŞ SİLİNECEK ... EMİNMİSİNİZ ?", vbYesNo)
If cevap = vbYes Then
   Sheets("Data").Range("A:A").Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate
sil = ActiveCell.row
   Sheets("Data").Rows(sil).Delete
                     
        End If
        End If
Call Main 'Progress Bar
       
For a = 1 To 39
Controls("textbox" & a) = ""
Next

ListBox1.List = Sheets("Data").Range("A2:am" & Cells(Rows.Count, 1).End(xlUp).row).Value
TextBox52.Value = ListBox1.ListCount
End Sub

Private Sub CommandButton4_Click() 'CLEAR BUTTON
Dim del As Control
    For Each del In UserForm1.Controls
        If TypeName(del) = "TextBox" Or TypeName(del) = "ComboBox" Then
            del.Text = ""
        ElseIf TypeName(del) = "ListBox" Then
            del.Value = ""
       
        End If
    Next del
    Call Main 'Progress Bar
TextBox52.Value = ListBox1.ListCount
Label15.Caption = ""
UserForm_Initialize
End Sub

Private Sub CommandButton5_Click() 'Search Button
Dim sat, s As Long
Dim deg1, deg2 As String
If TextBox51.Value = "" Then
MsgBox "Bir Kayıt Giriniz", vbExclamation
TextBox51.SetFocus
Exit Sub
End If

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

If ComboBox1.Value = "" Or ComboBox1.Value = "-" Then
MsgBox "Choose a filter field", vbExclamation
ComboBox1.SetFocus
Exit Sub
End If

For a = 1 To 39 ' Clear textboxes(1-39)
Controls("textbox" & a) = ""
Next
With ListBox1
.Clear
.ColumnCount = 39
.ColumnWidths = "140;85;140;85;140;85;85;85;85;120;140;120;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;200"
End With
Call Main 'Progress Bar

deg2 = TextBox51.Value
Select Case ComboBox1.Value
Case "İŞYERİ TÜRÜ"
For sat = 2 To Cells(Rows.Count, 1).End(xlUp).row
Set deg1 = Cells(sat, "A")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "VERGİ NO"
For sat = 2 To Cells(Rows.Count, 2).End(xlUp).row
Set deg1 = Cells(sat, "B")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "İŞYERİ ÜNVANI"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "C")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "PAYDAŞ NO"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "D")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "ADI SOYADI"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "E")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "TC KİMLİK NO"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "F")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "MAHALLE"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "J")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "CADDE"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "K")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "SOKAK"
For sat = 2 To Cells(Rows.Count, 4).End(xlUp).row
Set deg1 = Cells(sat, "L")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next

Case "KAPI NO"
For sat = 2 To Cells(Rows.Count, 9).End(xlUp).row
Set deg1 = Cells(sat, "M")
If deg1 Like deg2 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
ListBox1.List(s, 12) = Cells(sat, "M")
ListBox1.List(s, 13) = Cells(sat, "N")
ListBox1.List(s, 14) = Cells(sat, "O")
ListBox1.List(s, 15) = Cells(sat, "P")
ListBox1.List(s, 16) = Cells(sat, "Q")
ListBox1.List(s, 17) = Cells(sat, "R")
ListBox1.List(s, 18) = Cells(sat, "S")
ListBox1.List(s, 19) = Cells(sat, "T")
ListBox1.List(s, 20) = Cells(sat, "U")
ListBox1.List(s, 21) = Cells(sat, "V")
ListBox1.List(s, 22) = Cells(sat, "W")
ListBox1.List(s, 23) = Cells(sat, "X")
ListBox1.List(s, 24) = Cells(sat, "Y")
ListBox1.List(s, 25) = Cells(sat, "Z")
ListBox1.List(s, 26) = Cells(sat, "AA")
ListBox1.List(s, 27) = Cells(sat, "AB")
ListBox1.List(s, 28) = Cells(sat, "AC")
ListBox1.List(s, 29) = Cells(sat, "AD")
ListBox1.List(s, 30) = Cells(sat, "AE")
ListBox1.List(s, 31) = Cells(sat, "AF")
ListBox1.List(s, 32) = Cells(sat, "AG")
ListBox1.List(s, 33) = Cells(sat, "AH")
ListBox1.List(s, 34) = Cells(sat, "AI")
ListBox1.List(s, 35) = Cells(sat, "AJ")
ListBox1.List(s, 36) = Cells(sat, "AK")
ListBox1.List(s, 37) = Cells(sat, "AL")
ListBox1.List(s, 38) = Cells(sat, "AM")
s = s + 1
End If: Next
End Select

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

Label15.Caption = ListBox1.ListCount
End Sub

Private Sub CommandButton6_Click() 'Clear Search Textbox Button
TextBox51.Value = "": ComboBox1.Value = ""
ListBox1.List = Sheets("Data").Range("A2:am" & Cells(Rows.Count, 1).End(xlUp).row).Value
Label15.Caption = ""
End Sub

Private Sub CommandButton7_Click() 'Close Button
Unload Me
End Sub

Private Sub Label10_Click()

End Sub

Private Sub Label11_Click()

End Sub

Private Sub Label3_Click()

End Sub

Private Sub Label9_Click()

End Sub

Private Sub ListBox1_Click()
Dim say As Long, a As Byte

For a = 0 To 38
Controls("textbox" & a + 1) = ListBox1.column(a)
Next

LastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).row
Sheets("Data").Activate
Sheets("Data").Range("A2:A" & LastRow).Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate

say = ActiveCell.row
TextBox50.Value = say

Sheets("Data").Range("A" & say & ":AM" & say).Select

End Sub

Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex + 1
    End With
End Sub

Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub

With Me.ListBox1
        .ListIndex = .ListIndex - 1
    End With
    End Sub


Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
    Application.Visible = False
   End If
   If ToggleButton1.Value = True Then
    Application.Visible = True
   
End If
End Sub

Private Sub UserForm_Initialize()

ListBox1.ColumnWidths = "140;85;140;85;140;85;85;85;85;120;140;120;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;85;200"        'COLUMN WITH OF LISTBOX
ListBox1.ColumnCount = 39                                                 'COLUMN NUMBER OF LISTBOX
ListBox1.List = Sheets("Data").Range("A2:am" & Cells(Rows.Count, 1).End(xlUp).row).Value

'** SEARCH COMBOBOX
ComboBox1.AddItem "İŞYERİ TÜRÜ"
ComboBox1.AddItem "VERGİ NO"
ComboBox1.AddItem "İŞYERİ ÜNVANI"
ComboBox1.AddItem "PAYDAŞ NO"
ComboBox1.AddItem "ADI SOYADI"
ComboBox1.AddItem "TC KİMLİK NO"
ComboBox1.AddItem "MAHALLE"
ComboBox1.AddItem "CADDE"
ComboBox1.AddItem "SOKAK"
ComboBox1.AddItem "KAPI NO"
'**********************************************

TextBox52.Value = ListBox1.ListCount
TextBox50.Value = ""
With lblDone ' set the "progress bar" to it's initial length
        .Top = lblRemain.Top + 1
        .Left = lblRemain.Left + 1
        .Height = lblRemain.Height - 2
        .Width = 0
    End With
lblPct.Visible = False

End Sub
' PROGRESS BAR CODES
Sub Main()
Dim i As Long, tot As Long
     tot = 10000
     For i = 1 To tot
        If i Mod 5 = 0 Then ProgressBar i / tot
        ' do something
    Next i
   
   Call Back
     End Sub
Sub ProgressBar(PctDone As Single)
    With UserForm1
        .lblDone.Width = PctDone * (.lblRemain.Width - 2)
        .lblPct.Visible = True
        .lblPct.Caption = Format(PctDone, "0%")
    End With
   
    Select Case UserForm1.lblPct.Caption
    Case "10%"
        UserForm1.Frame5.Visible = True
       
    Case "20%"
        UserForm1.Frame6.Visible = True
               
    Case "30%"
        UserForm1.Frame7.Visible = True
       
    Case "40%"
       UserForm1.Frame8.Visible = True
       
    Case "50%"
       UserForm1.Frame9.Visible = True
           
    Case "60%"
        UserForm1.Frame10.Visible = True
           
    Case "70%"
     UserForm1.Frame11.Visible = True
           
    Case "80%"
     UserForm1.Frame12.Visible = True
       
    Case "90%"
       UserForm1.Frame13.Visible = True
               
    Case "100%"
      UserForm1.Frame14.Visible = True
               
    End Select
    DoEvents

End Sub
' END OF PROGRESS BAR CODES
Sub Back()
For a = 5 To 14
Controls("Frame" & a).Visible = False
Next
lblDone.Width = 0
lblPct.Visible = False
End Sub


Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
fmceyhan25
Yeni Başlamış
 
Kayıt: 17 May 2017 23:31
Meslek: buro
Yaş: 34
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul

Cevap: userform arama sonrası listbox verileri yazdırma buto

İleti#2)  fmceyhan25 » 16 Nis 2018 10:04

yokmu bilen :?
Kullanıcı avatarı
fmceyhan25
Yeni Başlamış
 
Kayıt: 17 May 2017 23:31
Meslek: buro
Yaş: 34
İleti: 28
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul


Forum ListBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Yandex[Bot] ve 1 misafir

Bumerang - Yazarkafe