Sayfa Adlarının (Sekme Adı) Listelenmesi

[oerbas]

ListBox1 içinde Sayfa isimlerini Alfabetik olarak nasıl listeleyebilirim yardımcı olacak arkadaşa teşekkürler

 

[Haluk]

Başka bir çalışmada ComboBox için benzer bir çalışmam vardı. Orada durum biraz daha farklıydı ama kodları bu durum için biraz revize ederek...

UserForm modulüne:

Private Sub UserForm_Initialize()
    MyForm = Me.Name
    OrganizeListBox
End Sub

Yeni bir module:

Dim MyForm As Variant
Option Base 1
'
Sub OrganizeListBox()
Dim noData, i, j
Dim MyLboxArray()
Dim SortedColl As New Collection
Dim Swap1, Swap2
'
    noData = ThisWorkbook.Sheets.Count
    ReDim MyLboxArray(noData)
    For Each Sh In ThisWorkbook.Sheets
        i = i + 1
        MyLboxArray(i) = Sh.Name
    Next Sh
'
    For i = 1 To UBound(MyLboxArray)
        MyLboxArray(i) = UCase(MyLboxArray(i))
        MyLboxArray(i) = Replace(MyLboxArray(i), "Ç", "C")
        MyLboxArray(i) = Replace(MyLboxArray(i), "İ", "I")
        MyLboxArray(i) = Replace(MyLboxArray(i), "Ð", "G")
        MyLboxArray(i) = Replace(MyLboxArray(i), "Þ", "S")
        MyLboxArray(i) = Replace(MyLboxArray(i), "Ü", "U")
        MyLboxArray(i) = Replace(MyLboxArray(i), "Ã?", "O")
        SortedColl.Add MyLboxArray(i)
    Next i
'
    For i = 1 To SortedColl.Count - 1
        For j = i + 1 To SortedColl.Count
            If SortedColl(i) > SortedColl(j) Then
                Swap1 = SortedColl(i)
                    Swap2 = SortedColl(j)
                        SortedColl.Add Swap1, before:=j
                    SortedColl.Add Swap2, before:=i
                    SortedColl.Remove i + 1
                SortedColl.Remove j + 1
            End If
        Next j
    Next i
'
    For i = 1 To SortedColl.Count
        UserForms(MyForm).ListBox1.AddItem SortedColl(i)
    Next i
'
Erase MyLboxArray
'
End Sub

 

[Haluk]

xxrt' nin aşağıdaki mesajını görmemişim, kendisinden özür dilerim.

http://www.excel.web.tr/viewtopic.php?t=859

 

[xxrt]

Estafurullah Hocam O Kodlarıda muhtemelen zamanında sizden almışımdır..Zaten verdiğiniz linkteki Sadece Sayaf Adlarının sıralanması hakkında,sizinkisi ListBoxun içindeki Sayfaların Sıralanması..Benimkinide O Ünlü(Bana Göre) çalışmamda kullanmıştım.Zaten O Çalışmada Bitmedi.Bitirmiyeceğimde... :hiho:

Verdiğiniz
http://www.excel.web.tr/viewtopic.php?t=859 linkinde

Sayfa isimlerinin ListBoxta Alfabetik olarak listelenmesi gerekiyor. Makro Bilgim bu formla tanışmaya başladıktan sonra şekillenmeye başladı bu yüzdende çok uğraştımama rağmen yapamadım yardımcı olursanız sevindirmiş olursunuz

Sayın oerbas'da sayenizde sorunuza cevap aldı.Sorusunu,Þimdiki gibi yeni başlık altına alsaydı görürdük.Ama geç olsada cevabı verildi.

 

[oerbas]

Hocam Aşağıdaki Kodu UserForm Kod bölümüne kopyaladım

Private Sub UserForm_Initialize()
MyForm = Me.Name
OrganizeListBox
End Sub

Bu Koduda Yeni Modüle kopyaladım ama bir sonuç alamadım. Herhalde ben birşeyleri yanlış yapıyorum Gönderdiğim örnek dosyada inceleme yapabilirmisiniz

Dim MyForm As Variant
Option Base 1
'
Sub OrganizeListBox()
Dim noData, i, j
Dim MyLboxArray()
Dim SortedColl As New Collection
Dim Swap1, Swap2
'
noData = ThisWorkbook.Sheets.Count
ReDim MyLboxArray(noData)
For Each Sh In ThisWorkbook.Sheets
i = i + 1
MyLboxArray(i) = Sh.Name
Next Sh
'
For i = 1 To UBound(MyLboxArray)
MyLboxArray(i) = UCase(MyLboxArray(i))
MyLboxArray(i) = Replace(MyLboxArray(i), "Ç", "C")
MyLboxArray(i) = Replace(MyLboxArray(i), "İ", "I")
MyLboxArray(i) = Replace(MyLboxArray(i), "Ð", "G")
MyLboxArray(i) = Replace(MyLboxArray(i), "Þ", "S")
MyLboxArray(i) = Replace(MyLboxArray(i), "Ü", "U")
MyLboxArray(i) = Replace(MyLboxArray(i), "Ã?", "O")
SortedColl.Add MyLboxArray(i)
Next i
'
For i = 1 To SortedColl.Count - 1
For j = i + 1 To SortedColl.Count
If SortedColl(i) > SortedColl(j) Then
Swap1 = SortedColl(i)
Swap2 = SortedColl(j)
SortedColl.Add Swap1, before:=j
SortedColl.Add Swap2, before:=i
SortedColl.Remove i + 1
SortedColl.Remove j + 1
End If
Next j
Next i
'
For i = 1 To SortedColl.Count
UserForms(MyForm).ListBox1.AddItem SortedColl(i)
Next i
'
Erase MyLboxArray
'
End Sub

 

[Haluk]

Benim kodda bir problem var sanıyorum, bir ara ilgilenirim.

 

[Haluk]

Benim kod yerine xxrt' nin başka bir kodu vardı. Onu kullanın bence.

Yani;

Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then
    CommandButton1.Enabled = False
    Else
    CommandButton1.Enabled = True
    End If
    Label1.Caption = UCase(ListBox1.Value)
End Sub
'
Private Sub UserForm_Initialize()
Dim i As Integer
    Dim j As Integer
    Label1.Caption = ""
    If Worksheets.Count = 1 Then Exit Sub
    For i = 1 To Worksheets.Count
    Sheets(i).Name = LCase(Sheets(i).Name)
        For j = i + 1 To Worksheets.Count
            If LCase(Worksheets(j).Name) < LCase(Worksheets(i).Name) Then
                Worksheets(j).Move Before:=Worksheets(i)
            End If
        Next j
    Next i
    For i = 1 To Sheets.Count
        ListBox1.AddItem Sheets(i).Name
    Next
    Sheets("ana sayfa").Move Before:=Sheets(1)
End Sub

Dip Not: Dosya isimleri, Sayfa isimleri, Alan isimleri ... gibi işlerde kesinlikle Türkçe karakter kullanmayın. Çünkü Türkçe karakterlerin kodları olması gerektiği gibi değildir ve özellikle VBA' de bu tip bir sırlama falan gibi durumlarda problem çıkartır.

 

[oerbas]

Tam istediğim gibi olmuş.


Yalnız. Þöyle birşey yapabilirmiyiz. Liste Kutusunun üzerinde bir OptionButon var Bu butonu tıklatığımızda Liste bilgileri gözüksün olabilirmi

 

[Haluk]

O zaman UserForm_Initialize() prosedurunü silin ve aşağıdakini yerleştirin.

Private Sub OptionButton1_Click()
Dim i As Integer
    Dim j As Integer
    Label1.Caption = ""
    If Worksheets.Count = 1 Then Exit Sub
    For i = 1 To Worksheets.Count
    Sheets(i).Name = LCase(Sheets(i).Name)
        For j = i + 1 To Worksheets.Count
            If LCase(Worksheets(j).Name) < LCase(Worksheets(i).Name) Then
                Worksheets(j).Move Before:=Worksheets(i)
            End If
        Next j
    Next i
    For i = 1 To Sheets.Count
        ListBox1.AddItem Sheets(i).Name
    Next
    Sheets("ana sayfa").Move Before:=Sheets(1)
End Sub

 

[oerbas]

Hocam harikasınız. Emin olun her gönderdiğniz çözümde çocuklar gibi seviniyorum

 

[Kemal Demir]

Sub ListelemeYap()
'Sheetlere göre listeleme yapar'
Sheets.Add
With Sheets(1)
For i = 1 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
.Hyperlinks.Add Anchor:=Cells(i, 1), _
Address:="", SubAddress:=Sheets(i).Name & "!A1"
Sheets(i).Range("A1") = Sheets(1).Name
Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), _
Address:="", SubAddress:=Sheets(1).Name & "!A1"
Next
End With

End Sub



Böle birşeymı acaba ben mı yanlıs anlamadım..
Kolay gelsin