Arama Ekranı

[HarEndu]

Merhaba, Buradaki forumdan yararlanarak sirket icerisinde kullanilan bir form tasarladim cok da guzel oldu sanirim. Bu formu biraz daha gelistirmek istiyorum. Cok arama ugrasmama ragmen benzer ornek bulamadim ya da uyarlayamadim.
Istedigim Arama butonu yapmak. Arama butonu ile musteri bilgilerine ulasip onu forma tasimak. Simdiden tesekkur ederim.

 

[YUSUF44]

Sırasıyla aşağıdakileri yaparsanız istediğiniz olur, belirtmediğim düzenlemeleri kendiniz halledersiniz:

Dosyanıza bir userform ekleyin, genişliği en az 360, yüksekliği en az 475 olsun
Üst kısma bir label bir de textbox ekleyin
Labelin captionını Müşteri veya Customer nasıl isterseniz ayarlayın
Textboxın altına bir listbox ekleyin
Listboxın altına yan yana 2 tane command button ekleyin, biri seçimi iptal etmek biri de userformu kapatmak için kullanılacak
Listboxın columnwidths özelliğini 60 pt;120 pt;90 pt;60 pt olarak ayarlayın
Userformun kod bölümünü açın ve aşağıdaki kodları ekleyin:

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub CommandButton3_Click()
    ListBox1.ColumnHeads = True
    ListBox1.ColumnHeads = False
End Sub

Private Sub ListBox1_Change()
    [D9] = ListBox1.List(ListBox1.ListIndex, 1)
    [D10] = ListBox1.List(ListBox1.ListIndex, 2)
    [D11] = ListBox1.List(ListBox1.ListIndex, 0)
    [D12] = ListBox1.List(ListBox1.ListIndex, 3)
End Sub

Private Sub TextBox1_Change()
    TextBox1.Text = Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")
    Set s1 = Sheets("Musteri")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)
    
    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
    
    sorgu = "select distinct [Vergi No],Unvan,Addres,Telefon from [Musteri$] where [Vergi No] like '%" & TextBox1.Text & "%' or [Unvan] like '%" & TextBox1.Text & "%'" _
            & " or Addres like '%" & TextBox1.Text & "%'"
    Set rs = con.Execute(sorgu)
    If Not rs.EOF Then
        ListBox1.ColumnCount = 4
        ListBox1.Column = rs.getrows
    Else
        ListBox1.Clear
    End If
    [A1].Select
End Sub

Private Sub UserForm_Initialize()
    Set s1 = Sheets("Musteri")
    son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "C").End(3).Row)
    
    Set con = VBA.CreateObject("adodb.Connection")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""
    
    sorgu = "select distinct [Vergi No], Unvan, Addres, Telefon from [Musteri$] "
    Set rs = con.Execute(sorgu)
    ListBox1.ColumnCount = 4
    ListBox1.Column = rs.getrows
End Sub

Invoice sayfasında mevcut worksheetchange kodlarını aşağıdakiyle değiştirin:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If (Not Intersect(Target, Range("H4")) Is Nothing) Then
        UserForm1.Show 0
    ElseIf (Not Intersect(Target, Range("D9")) Is Nothing) Then
        UserForm2.Show 0
    End If
End Sub

 

[HarEndu]

Harika bu Yusuf bey, deneyip sonucu bildireceğim. İnş. Başarırım. Çok teşekkür ederim desteğiniz için.

 

[HarEndu]

Yusuf bey merhaba, Dosyayla ilgili bir hata aliyorum. 'Cannot update. Database or Object is read-only' hatasi var. bir turlu cozemiyorum. Dolayisiylada ilerleyemedim. Tesekkurler...
Asagidaki veriyi hata olarak goruyor.
provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

 

[YUSUF44]

Bende sıkıntı olmadı.

Dosyayı Onedrive gibi bulut üzerinden kullanıyor olabilir misiniz? Eğer öyleyse ADO bulutta çalışmıyor ve çalıştırma yöntemi var mı bilmiyorum.

 

[HarEndu]

Yusuf bey, sanirim dogru soyluyorsunuz. Bilgisayarim yeni alindi ve onedrive yuklu. butun dosyalari orada goruyor. ilginize cok tesekkur ederim. baska bir yol denemeliyim.

 

[YUSUF44]

Dosyayı onedrivedan bilgisayara taşıyabilirsiniz.

 

[HarEndu]

Merhaba,
bir arama ekrani uzerinde calisiyorum. Ornek dosyada buton hangi sekmedeyse o sayfada arama yapiyor. Sayfayi nasil sabitleyebilirim. kac gundur ugrasiyorum cozemiyorum. lutfen kusura bakmayin.

 

[YUSUF44]

Ne istediğiniz anlaşılmıyor maalesef. Yani ne yapmak isterken ne oluyor ya da ne olmasını istiyorsunuz belli değil.

Bulunulan sayfa yerine belirli bir sayfada işlem yapmak istiyorsanız yapılan işlemde o sayfayı belirtmeniz gerekir. Örneğin

[A1] = Toplam

kodu açık olan sayfada A1 hücresine Toplan değişkenini yazarken

Sheets("İcmal").[A1] = Toplam

olarak kullanıldığında açık olan sayfada değil icmal sayfasında işlem yapılır.

 

[HarEndu]

Yusuf bey, bir arama kutusu ekledim ve excel sayfasinda iki tane sekmem var. Bir buton ekledim her iki sayfaya da. "Cus" sekmesinde musteri bilgilerinin oldugu tablo listesi var. Bu sayfaya ekledigim buton arama yapiyor ama Form butonunu "Ana" sekmesine tasidigimda listview e musteri bilgileri geliyor fakat bir musteri aradigimda bos geliyor.

 

[YUSUF44]

Userformunuzdaki textboxların ne olduğunu belirtmediğiniz için anlamakta zorlandım.

Önceki mesajımda belirttiğim gibi kodunuzda hangi sayfada arama ya da işlem yapılacağını belirtmeniz gerekir. Örneğin Search1 Change kodunu aşağıdaki gibi deneyin:

Private Sub Search1_Change()
Set b = Sheets("Cus")
ListView1.ListItems.Clear
On Error Resume Next
FD = UCase(Replace(Replace(Search1, "?", "I"), "i", "I."))
For i = 2 To b.[a65536].End(3).Row
    If UCase(Replace(Replace(Sheets("Cus").Cells(i, 2).Value, "?", "I"), "i", "I.")) _
            Like "*" & FD & "*" Then
        Set Liste = ListView1.ListItems.Add(, , Cells(i, 1).Value)
        Liste.SubItems(1) = b.Cells(i, 2).Value
        Liste.SubItems(2) = b.Cells(i, 3).Value
        Liste.SubItems(3) = b.Cells(i, 4).Value
        Liste.SubItems(4) = b.Cells(i, 5).Value
        Liste.SubItems(5) = b.Cells(i, 6).Value
        Liste.SubItems(6) = b.Cells(i, 7).Value
    End If
Next i
End Sub

 

[HarEndu]

Cok tesekkur ediyorum. evet oldu. emeginize saglik olsun.