Soru Sayfalara Kolay Ulaşım

[hakanimamoglu]

Merhabalar excel çalışma kitabımda 100 den fazla sayfa var . Kolay ulaşmak için ne yapabilirim . Menü ye ekleme vs. bir yolu olabilir mi ?
Fikirlerizi alabilir miyim
Saygılar

 

[Muzaffer Ali]

Merhaba.

Dosyanıza yeni bir form ekleyin.
Formun adını "frmSayfalar" olarak değiştirin.
Forma bir ListBox ekleyin.
Aşağıdaki kodları formun kod kısmına kopyalayın.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ThisWorkbook.Worksheets(ListBox1.Text).Activate
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim syf As Worksheet
    For Each syf In ThisWorkbook.Worksheets
        ListBox1.AddItem syf.Name
    Next
    Sirala ListBox1
End Sub
'Sayfaları alfabetik listelemek için gerekli. İstemiyorsanız silebilirsiniz.
Sub Sirala(Liste As MSForms.ListBox)
    Dim x, tmp
    Dim i As Long, j As Long
    x = Liste.List
    For i = LBound(x, 1) To UBound(x, 1) - 1
        For j = i + 1 To UBound(x, 1)
            If x(i, 0) > x(j, 0) Then
                tmp = x(i, 0)
                x(i, 0) = x(j, 0)
                x(j, 0) = tmp
            End If
        Next j
    Next i
    Liste.Clear
    For i = LBound(x, 1) To UBound(x, 1)
        Liste.AddItem x(i, 0)
    Next i
End Sub

Dosyanıza yeni bir Module ekleyin, aşağıdaki kodları modüle kopyalayın.

Sub SayfaAc()
    frmSayfalar.Show
End Sub

Kod kısmını kapatıp Excel kısımı açın.
Geliştirici sekmesinden Makrolar tıklatın.
Açılan pencerede "SayfaAc" makrosunu bulup seçin. Seçenekleri tıklatın.

Kısayol tuşu kısmına istediğiniz harfi yazın. Örneğin "q"
Pencereyi kapatın.

Oluşturduğunuz kısayol tuşlarına basın "CTRL+q" listeden açmak istediğiniz sayfa adını çift tıklatın.

Örnek dosya ekte

 

[hakanimamoglu]

Süper oldu teşekkürler 9

 

[hakanimamoglu]

Sıralamayı silmek için

Sub Sirala(Liste As MSForms.ListBox)
Dim x, tmp
Dim i As Long, j As Long
x = Liste.List
For i = LBound(x, 1) To UBound(x, 1) - 1
For j = i + 1 To UBound(x, 1)
If x(i, 0) > x(j, 0) Then
tmp = x(i, 0)
x(i, 0) = x(j, 0)
x(j, 0) = tmp
End If
Next j
Next i
Liste.Clear
For i = LBound(x, 1) To UBound(x, 1)
Liste.AddItem x(i, 0)
Next i

Burayımı silmeliyim

 

[Muzaffer Ali]

Evet ve şu satırı Sirala ListBox1

 

[hakanimamoglu]

Teşekkürler

 

[aliberberoglu1981]

Merhaba.

Dosyanıza yeni bir form ekleyin.
Formun adını "frmSayfalar" olarak değiştirin.
Forma bir ListBox ekleyin.
Aşağıdaki kodları formun kod kısmına kopyalayın.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ThisWorkbook.Worksheets(ListBox1.Text).Activate
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim syf As Worksheet
    For Each syf In ThisWorkbook.Worksheets
        ListBox1.AddItem syf.Name
    Next
    Sirala ListBox1
End Sub
'Sayfaları alfabetik listelemek için gerekli. İstemiyorsanız silebilirsiniz.
Sub Sirala(Liste As MSForms.ListBox)
    Dim x, tmp
    Dim i As Long, j As Long
    x = Liste.List
    For i = LBound(x, 1) To UBound(x, 1) - 1
        For j = i + 1 To UBound(x, 1)
            If x(i, 0) > x(j, 0) Then
                tmp = x(i, 0)
                x(i, 0) = x(j, 0)
                x(j, 0) = tmp
            End If
        Next j
    Next i
    Liste.Clear
    For i = LBound(x, 1) To UBound(x, 1)
        Liste.AddItem x(i, 0)
    Next i
End Sub

Dosyanıza yeni bir Module ekleyin, aşağıdaki kodları modüle kopyalayın.

Sub SayfaAc()
    frmSayfalar.Show
End Sub

Kod kısmını kapatıp Excel kısımı açın.
Geliştirici sekmesinden Makrolar tıklatın.
Açılan pencerede "SayfaAc" makrosunu bulup seçin. Seçenekleri tıklatın.

Kısayol tuşu kısmına istediğiniz harfi yazın. Örneğin "q"
Pencereyi kapatın.

Oluşturduğunuz kısayol tuşlarına basın "CTRL+q" listeden açmak istediğiniz sayfa adını çift tıklatın.

Örnek dosya ekte

hocam kolay gelsin bende böyle çok excel sayfası ile çalışıyorum aynı sorun bende de var sizin örnek sayfanızı inceledim ama anlayamadım. macrolar fazla anlamıyorum nasıl form ekleyeceğiz ve buna listbox ekleyeceğiz bilmiyorum yardımcı olurmusunuz

 

[euphrates55]

Sub SayfaIndex()
Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  If WorksheetExists("SayfaIndex") Then Sheets("SayfaIndex").Delete
  Set NewSh = Sheets.Add(Before:=Sheets(1))
  NewSh.Name = "SayfaIndex"

  Cells.ClearContents
  kolon = 1
  satir = 2
  Cells(1, 1).Select
  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"

  For i = 2 To Sheets.Count
    Cells(satir, kolon).Value = Sheets(i).Name
    Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, 1), Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(satir, kolon), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
    satir = satir + 1
    If satir = 26 Then
       kolon = kolon + 1
       satir = 2
    End If
  Next i

  Cells.Select
  Cells.EntireColumn.AutoFit
  Range("E1").Select

  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function

böyle bir kod var arşivimde. en başa bir sekme ekler ve her diğer sekmeye köprü linki verir. diğer sayfalarında da a1 hücresi boş olmalı çünkü buraya da ana sayfaya dönmesi için bir link koyuyor.

 

[hb3102]

Merhaba emeğinize sağlık kullandığım bir excell dosyasında bu kodlar çok işime yaradı.Sizden bir ricam olacak excell sayfalarını combobox açılır pencereye yazıp o sayfayı getirmesini sağlayabilir miyiz.