açılır listeye köprü ekleme

[asem33]

merhaba arkadaşlar;

geçmiş çalışmaları inceledim ama bir türlü işin içinden çıkamadım. ekli sayfadaki menüden sayfayı seçince nasıl o sayfaya otomatik olarka köprülü şekilde gidebiliri. yardımcı olursanız sevinirim.

 

[hamitcan]

Alternatif olsun, aşağıdaki örneği inceleyin.
http://www.excel.web.tr/showthread.php?t=75377&highlight=sa%F0+klik+men%FC

 

[asem33]

ilginiz için çok teşekkürler hamit bey.. ama ben geçen combo box açılan menüde seçince direk otomatik köprü ile o sayfaya giden bir çalışma görmüştüm . nasıl yapıldığını merak ettim? bu konudada yardımcı olursanız sevinirim..

 

[hamitcan]

Eki inceleyin.

Sub SayfayaGit()
    Dim x As String
    
    With Sayfa4.DropDowns(1) 'Sayfa4 sayfanın kod ismi
    .ListFillRange = [d6:d15].Address 'İlgili aralığı açılan kutuya al.
    End With
    
    x = "Sayfa" & Sayfa4.DropDowns(1).Value 'Sayfa ismini belirle.
    If WorksheetExists(x) = True Then 'Sayfa var mı yok mu tespit et
        Sheets(x).Select
    Else
        MsgBox "Böyle Bir Sayfa Yok"
    End If
End Sub

' Sayfanın olup olmadığını kontrol eden fonksiyon.
Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Len(Worksheets(WSName).Name) > 0
End Function

 

[asem33]

hocam çok teşekkürler fakat makro bulanamadı diye hata veriyor

 

[hamitcan]

Dosyayı yeniledim.

 

[asem33]

hocam istediğim tam anlamıyla buydu çok teşekkür ederim. nasıl yaptığınızı anlatabilirmisiniz. bende kendi sayfama uyarlayabileyeyim

 

[asem33]

hocam birde sayfaların ismini değiştiremiyorum.

 

[asem33]

makroda sayfa 4 yazıyor nedeninini çıkaramadım hocam?

 

[hamitcan]

Gerekli açıklamaları 4.mesajda bulabilirsiniz.

 

[asem33]

hocam olmuyor böyle bir sayfa yok diye hata veriyor devamlı ne yapmam lazım acaba?

 

[hamitcan]

D6: D15 aralığında sayfa isimleri belirtmişsiniz. Bu isimlerle açılmış sayfalarınız var mı ? Eğer yok ise böyle bir mesaj vermesi doğal.

 

[asem33]

kendi sayfa isimlerimi yazdım o kolona hocam.

 

[asem33]

sinter
pik
sıvıçelik
kütük
slab
kangal
bobin
esas ürün
performans
rekorlar
kalite
sayfa isimleri bunlar hocam

 

[hamitcan]

Aşağıdaki şekilde deneyin.

Sub SayfayaGit()
    Dim x As String
    
    With Sayfa4.DropDowns(1)
    .ListFillRange = [d6:d15].Address
    End With
    
    x = Sayfa4.Cells(Sayfa4.DropDowns(1).Value + 5, 4)
    If WorksheetExists(x) = True Then
        Sheets(x).Select
    Else
        MsgBox "Böyle Bir Sayfa Yok"
    End If
End Sub


Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Len(Worksheets(WSName).Name) > 0
End Function

 

[asem33]

hocam çok özür dileyerek son bir soru daha sorayım sizin kodu kendi sayfama kopyalıyorum. fakat daha sonra çalıştırdığımsa sizin köprü2.xls deki sayfayı açıyor. .. açılır kutuyu kopyalıyorum yine aynı şey oluyor ne yapmam lazım acaba? birde kodtaki x = Sayfa4.Cells(Sayfa4.DropDowns(1).Value + 5, 4) 5 ve 4 ne demek sayfa 4 ü anladım diğer 5 ve4
ilginiz için çok teşekkür ederim.

 

[hamitcan]

hocam çok özür dileyerek son bir soru daha sorayım sizin kodu kendi sayfama kopyalıyorum. fakat daha sonra çalıştırdığımsa sizin köprü2.xls deki sayfayı açıyor.

Bunun sebebi benim sayfamdaki Açılan kutu benim sayfamdaki hücrelere link edilmiş durumda. Bu yüzden yeni bir Açılan kutu ekleyin ve verdiğim kodları içine ekleyin.

birde kodtaki x = Sayfa4.Cells(Sayfa4.DropDowns(1).Value + 5, 4) 5 ve 4 ne demek sayfa 4 ü anladım diğer 5 ve4

Sayfa4 > Sayfa4 sayfanın kod ismi
DropDowns(1).Value > Açılan kutudaki elemanın sıra nosu [/color]

Sayfa4.DropDowns(1).Value + 5 > Liste 6.satırdan başladığı için 5 rakamını eklemek gerekiyor.
x = Sayfa4.Cells(Sayfa4.DropDowns(1).Value + 5 =Sayfanın ismini buluyoruz.

 

[asem33]

hocam sizin tüm çabalarınıza rağmen ben işin içinden bir türlü çıkamadım. ekte kendi çalışma kitabımı gönderiyorum her sayfada olmak üzere açılır kutu olmasını istiyorum nerde yanlış yapıyorum sizce?

 

[hamitcan]

Sütunu yanlış tanımlamışsınız.

Sub SayfayaGit()
    Dim x As String
    
    With Sayfa5.DropDowns(1)
    .ListFillRange = [ae12:ae23].Address
    End With
    
[color=red] [B]   x = Sayfa5.Cells(Sayfa5.DropDowns(1).Value + 11, "ae")[/B][/color]
    MsgBox x
    If WorksheetExists(x) = True Then
        Sheets(x).Select
    Else
        MsgBox "Böyle Bir Sayfa Yok"
    End If
End Sub

 

[asem33]

hocam süpersiniz en sonunda oldu ) her sayfaya kopyalabilirim değil mi?