Select page from listbox index

[bilisim2010]

Hello everyone. I have a page named data in listbox index 4. When I click on the data in the listbox, it should open that page. What is the vba code for this?

 

[Logit]

In Sheet1 code module paste this :

Option Explicit

Private Sub SheetSelector_Change()
    Dim selectedSheet As String
    Dim listBox As OLEObject
    Set listBox = Me.OLEObjects("SheetSelector")
    selectedSheet = listBox.Object.Value
    If selectedSheet <> "" Then
        Worksheets(selectedSheet).Activate
    End If
End Sub

In the ThisWorkbook module paste this :

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim listBox As OLEObject
    Dim sheetNames As Collection
    Dim i As Long

    ' Initialize a collection to store worksheet names
    Set sheetNames = New Collection
    
    ' Loop through all sheets and add their names to the collection
    For Each ws In ThisWorkbook.Worksheets
        sheetNames.Add ws.Name
    Next ws

    ' Add a listbox to Sheet1 if not already present
    On Error Resume Next
    Set listBox = ThisWorkbook.Worksheets("Sheet1").OLEObjects("SheetSelector")
    On Error GoTo 0

    If listBox Is Nothing Then
        Set listBox = ThisWorkbook.Worksheets("Sheet1").OLEObjects.Add(ClassType:="Forms.ListBox.1", _
            Left:=10, Top:=10, Width:=150, Height:=100)
        listBox.Name = "SheetSelector"
    End If

    ' Populate the listbox with sheet names
    With listBox.Object
        .Clear
        For i = 1 To sheetNames.Count
            .AddItem sheetNames(i)
        Next i
    End With

    ' Assign the Change event handler if not already present
    Dim codeModule As Object
    Dim codeText As String
    Dim changeEventExists As Boolean
    Dim startLine As Long
    Dim endLine As Long

    Set codeModule = ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Worksheets("Sheet1").CodeName).codeModule
    changeEventExists = False

    ' Check if the macro already exists
    With codeModule
        startLine = 1
        endLine = .CountOfLines
        codeText = .Lines(startLine, endLine)
        If InStr(1, codeText, "Private Sub SheetSelector_Change()", vbTextCompare) > 0 Then
            changeEventExists = True
        End If
    End With

    ' Add the macro only if it does not already exist
    If Not changeEventExists Then
        codeModule.AddFromString GetChangeEventCode()
    End If
End Sub

Private Function GetChangeEventCode() As String
    GetChangeEventCode = _
        "Private Sub SheetSelector_Change()" & vbCrLf & _
        "    Dim selectedSheet As String" & vbCrLf & _
        "    Dim listBox As OLEObject" & vbCrLf & _
        "    Set listBox = Me.OLEObjects(""SheetSelector"")" & vbCrLf & _
        "    selectedSheet = listBox.Object.Value" & vbCrLf & _
        "    If selectedSheet <> """" Then" & vbCrLf & _
        "        Worksheets(selectedSheet).Activate" & vbCrLf & _
        "    End If" & vbCrLf & _
        "End Sub"
End Function

This code, when the workbook is opened, checks for the presence of a ListBox control on Sheet1. If it doesn't exist, one is created and the workbook sheet names are populated in
the ListBox control. If the ListBox control exists then one is not created but the worksheet names are populated therein.

The macro also checks to see if the macro shown in the Private Function exists with Sheet1 code module. If it doesn't one is created ... which is required for the sheet selection
process to work.

The user simply clicks on a sheet name and is taken to that worksheets. Returning to Sheet1 is a manual process.

 

[bilisim2010]

Sheet1 kod modülünün içeriği:

[KOD=vba]Seçenek Açık

Özel Alt SheetSelector_Change()
Seçilen Sayfayı Dizge Olarak Kıs
Dim listBox'ı OLEObject Olarak
listBox = Me.OLEObjects("SayfaSeçici") olarak ayarla
seçiliSayfa = listBox.Object.Value
Eğer seçiliSayfa <> "" ise
Çalışma Sayfaları(seçiliSayfa).Etkinleştir
Eğer Sonlandır
Son Alt Yazı
[/KOD]

ThisWorkbook modülünün içeriğinde şunlar bulunur:

[KOD]Özel Alt Çalışma Kitabı_Açık()
Dim ws Çalışma Sayfası
Dim listBox'ı OLEObject Olarak
Dim SheetNames Koleksiyon Olarak
Dim ve Uzun Süre

' Çalışma sayfası reklamlarını saklamak için bir koleksiyon başlatma
SheetNames = Yeni Koleksiyon'u ayarlayın

' Tüm sayfaların dolaşmasının ve isimlerini koleksiyonuna ekle
ThisWorkbook.Worksheets'teki ws için
sheetNames.Add ws.Name
Sonraki ws

' Zaten mevcut değil Sheet1'e bir liste kutusu ekleyin
Hata durumunda Devam Et Sonraki
listBox = ThisWorkbook.Worksheets("Sayfa1").OLEObjects("SayfaSeçici") olarak ayarla
Hata durumunda 0'a git

Eğer listBox Hiçbir Şeyse O Zaman
listBox = ThisWorkbook.Worksheets("Sayfa1").OLEObjects.Add(SınıfTürü:="Formlar.ListBox.1", _ olarak ayarla
Sol:=10, Üst:=10, Genişlik:=150, Yükseklik:=100)
listBox.Name = "SayfaSeçici"
Eğer Sonlandır

' Liste sayfası sayfa adlarıyla doldur
listBox.Object dosyası
.Temizlemek
i = 1 için sayfaAdları.Count'a
.AddItem sayfaAdları(i)
Sonraki ben
İle Sonlandır

'Zaten mevcut değil, değişiklik olayının işleyicisini atayın
Dim kodModülü Nesne Olarak
Dim kodmetni dize olarak
Dim changeEventExists Boolean Olarak
Dim başlangıç çızgisi Uzun
Dim endLine Uzunluğu

codeModule = ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Worksheets("Sayfa1").KodAdı).codeModule olarak setle
changeEventExists = Yanlış

' Makronun zaten mevcut olup olmadığını kontrol edin
kodModül ile
başlangıç satırı = 1
bitişSatırı = .SatırSayısı
kodMetni = .Lines(başlangıçSatırı, bitişSatırı)
Eğer InStr(1, codeText, "Özel Alt SheetSelector_Change()", vbTextCompare) > 0 ise
changeEventExists = Doğru
Eğer Sonlandır
İle Sonlandır

' Makroyu yalnızca içeriği mevcut değildir
Eğer Değilse değişiklikOlayMevcut O Zaman
codeModule.AddFromString GetChangeEventCode()
Eğer Sonlandır
Son Alt Yazı

Özel Fonksiyon GetChangeEventCode() Boyut Olarak
GetChangeEventCode = _
"Özel Alt SheetSelector_Change()" & vbCrLf & _
"Seçilen Sayfayı Dize Olarak Kıs" & vbCrLf & _
" listBox'ı OLEObject Olarak Kıs" & vbCrLf & _
" listBox = Me.OLEObjects(""SayfaSeçici"")" & vbCrLf & _
"seçilenSayfa = listBox.Object.Value" & vbCrLf & _
" Eğer seçilmişSheet <> """" O zaman" & vbCrLf & _
" Çalışma Sayfaları(seçiliSayfa).Etkinleştir" & vbCrLf & _
"Son Eğer" & vbCrLf & _
"Altyazı Sonu"
Oğul Fonksiyon
[/KOD]

Bu kod, çalışma kitabı açıldığında, Sheet1'de bir ListBox denetiminin kontrolünü yapar. Aksi halde, bir tane oluşur ve çalışma kitabı sayfa adları doldurulur.
ListBox denetimi. ListBox denetimi mevcutsa, bir tane oluşturulmaz ancak çalışma sayfası reklamları bunun içine doldurulur.

Teşekkürler. Ama bu sorumun cevabı değil, üzgünüm. Sadece listbox list 4'teki değerle bir sayfa seçmek istiyorum, bu kadar basit.
Teşekkürler. Ama bu sorumun cevabı değil, üzgünüm. Sadece listbox list 4'teki değerle bir sayfa seçmek istiyorum, bu kadar basit.
Makro ayrıca Private Function'da yapılandırılır makronun Sheet1 kod modülüyle mevcut olup olmadığını kontrol eder. Mevcut değilse, sayfa seçimi için gerekli olan bir tane oluşturulur.
Çalışma.

Kullanıcı sadece bir sayfa adına tıklar ve çalışma sayfalarına taşınır. Sheet1'e geri dönmek manuel bir işlemdir.

 

[Logit]

I had to use Google 'Translate' to interpret your response.

Are you pleased with the macro code ? Or do you require something more ?