Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 20-04-2017, 19:24   #1
işsiz123
Altın Üye
 
Giriş: 13/07/2016
Şehir: MARDİN
Mesaj: 285
Excel Vers. ve Dili:
Excel 2010 & 2016 Türkçe
Varsayılan Listboxta filitreme

Arkadaşlar Hayırlı Akşamlar Aşağıdaki kodla Klasör içindeki word dosyalarını listboxta sıralıyorum Yapmak istediğim Texbox1 ile yazacağım veri Listboxta listelensin Örnek olarak Textbox1 A yazsam a ile başlayan veriler listboxta sıralansın ve bulsun
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub UserForm_Initialize()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
For Each dosya In dc
If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 Then _
If InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then ListBox1.AddItem ds.GetBaseName(dosya)
Next
End Sub
__________________
#MEHMET EMİN ALKAN
“ Kendi dilini bilmeyen başka dil öğrenemez ”

Bu mesaj en son " 20-04-2017 " tarihinde saat 19:47 itibariyle işsiz123 tarafından düzenlenmiştir....
işsiz123 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 20-04-2017, 21:41   #2
PLİNT
 
Giriş: 30/12/2014
Şehir: Gürün
Mesaj: 1,074
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Aynı kodlara eklemeler yaparak listeleyebiliriniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub TextBox1_Change()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
ListBox1.Clear
For Each dosya In dc
If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 And InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then
If UCase(ds.GetBaseName(dosya)) Like UCase(TextBox1) & "*" Then ListBox1.AddItem ds.GetBaseName(dosya)
End If
Next
End Sub 
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 20-04-2017, 22:18   #3
işsiz123
Altın Üye
 
Giriş: 13/07/2016
Şehir: MARDİN
Mesaj: 285
Excel Vers. ve Dili:
Excel 2010 & 2016 Türkçe
Varsayılan

Alıntı:
PLİNT tarafından gönderildi Mesajı Görüntüle
Merhaba
Aynı kodlara eklemeler yaparak listeleyebiliriniz.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Private Sub TextBox1_Change()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("G:\çalışmalar\yeni\WORD HAZIRLA\")
Set dc = f.Files
ListBox1.Clear
For Each dosya In dc
If InStr(1, ds.GetExtensionName(dosya), "doc", vbTextCompare) > 0 And InStr(1, ds.GetBaseName(dosya), "$", vbTextCompare) = 0 Then
If UCase(ds.GetBaseName(dosya)) Like UCase(TextBox1) & "*" Then ListBox1.AddItem ds.GetBaseName(dosya)
End If
Next
End Sub 
Öncelikle ilginizden dolayı teşekkür ederim. Aşağıdaki kodlarla konu çözüldü
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
 Dim sFind As String
     
    sFind = Me.TextBox1.Text
     
    If Len(sFind) = 0 Then
        Me.ListBox1.ListIndex = -1
        Me.ListBox1.TopIndex = 0
    Else
        For i = 0 To Me.ListBox1.ListCount - 1
           If InStr(UCase(ListBox1.List(i)), UCase(sFind)) > 0 Then
                Me.ListBox1.TopIndex = i
                Me.ListBox1.ListIndex = i
                Exit For
            End If
        Next i
    End If
__________________
#MEHMET EMİN ALKAN
“ Kendi dilini bilmeyen başka dil öğrenemez ”

Bu mesaj en son " 16-05-2017 " tarihinde saat 15:56 itibariyle işsiz123 tarafından düzenlenmiştir....
işsiz123 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 05:43


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Hurda - Torna - Çorlu Web Tasarım - Tarot Falı - Fenerbahçe Haberleri - Trakya Haberleri - invest in turkey - Hurda - Tekirdağ Samsung - Kozmetik Ürünler - Sağlıklı Makyaj Ürünleri - Yaşlanma Karşıtı Ürünler - Excel Eğitimi - Çorlu osgb - Lingerie - Dyeing Machine - Çorlu Temizlik- Hazır Site- SEO- Çorlu Burun Estetiği- Çorlu Pimapen- Karton Bardak- Marka Tescil Danışmanlık- Marmara Ereğlisi Restaurant- Çorlu Baskı- Çorlu Sigorta- Çorlu Pimapenci- İstanbul Avukat- Çorlu Sürücü Kursu- Çorlu Rehabilitasyon- Edirne Su Arıtma- Çorlu Perde Yıkama-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden