DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub UserForm_Initialize()
MyForm = Me.Name
OrganizeListBox
End Sub
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
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' Alıntı: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
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 yapabilirmisinizPrivate Sub UserForm_Initialize()
MyForm = Me.Name
OrganizeListBox
End Sub
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
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
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