Hücreye Tıklandığında Sayfa açılsın

[k0081]

Merhaba arkadaşlar;

Belirli bir hücreye tıkladığımda o hücre içinde yazan sayfanın açılmasını nasıl sağlarım ?

yardımcı arkadaşa şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Bir örnek:

A1:A10 arasındaki veriye çift tıkladığınızda sayfa varsa sayfaya gider, yoksa yeni bir sayfa açar.

Sayfanın kod bölümüne kopyalayın.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim sayfa_adi As String
    
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    
    sayfa_adi = Target.Value
    If Target.Value = "" Then Exit Sub
    
    On Error GoTo atla
    Sheets(sayfa_adi).Select
    
    Exit Sub
atla:
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = sayfa_adi
    
End Sub

.

 

[ÖmerBey]

Sayfanın kod bölümüne uygulayınız.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([COLOR="Red"]Range("A1")[/COLOR], Target) Is Nothing Then Sheets(Target.Text).Select
End Sub

Kırmızı kısım belirli hücre

 

[k0081]

Ömer; - mucit77

Hocam söylemeyi unutmuşum. açılacak sayfa default olarak "gizli" durumda.. özür...

 

[fırat_raman]

Mrb arkadaşlar
Bu konuyla ilgili bir sorum olacak açmak istediğimiz sayfaya parola atıya bilirmiyiz örneğin ilgili sayfanın hücresine tıklanınca sayfa açılmadan önce parola sorsun parola doğru ise sayfa açılsın tabi bütün sayfalar için değil isteğe bağlı olması lazım iyi çalışmalar.

 

[Ömer]

Ömer; - mucit77

Hocam söylemeyi unutmuşum. açılacak sayfa default olarak "gizli" durumda.. özür...

Bu şekilde deneyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim sayfa_adi As String
    
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    
    sayfa_adi = Target.Value
    If Target.Value = "" Then Exit Sub
    
    On Error GoTo atla
    Sheets(sayfa_adi).Visible = True
    Sheets(sayfa_adi).Select
    
    Exit Sub
atla:
    Target.Offset(1, 0).Select
    MsgBox "Sayfayı Bulamadım."
    
End Sub

.

 

[Ömer]

Mrb arkadaşlar
Bu konuyla ilgili bir sorum olacak açmak istediğimiz sayfaya parola atıya bilirmiyiz örneğin ilgili sayfanın hücresine tıklanınca sayfa açılmadan önce parola sorsun parola doğru ise sayfa açılsın tabi bütün sayfalar için değil isteğe bağlı olması lazım iyi çalışmalar.

Bu şekilde deneyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim sayfa_adi As String, sor As Variant, parola As String
    
    If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
    
    sayfa_adi = Target.Value
    parola = "[COLOR="Red"]123[/COLOR]"

    On Error GoTo atla
    If Target.Value = "" Then Target.Offset(1, 0).Select: Exit Sub
    
    If sayfa_adi = "[COLOR="red"]Sayfa1[/COLOR]" Then'sadece Sayfa1 için sorar.
        sor = Application.InputBox("Paralo Nedir?", "Parola Girişi")
        If sor = "" Then Target.Offset(1, 0).Select: Exit Sub
        If sor = False Then Target.Offset(1, 0).Select: Exit Sub

        If sor = parola Then
            Sheets(sayfa_adi).Visible = True
            Sheets(sayfa_adi).Select
        Else
            Target.Offset(1, 0).Select
            MsgBox "Parola Hatalı."
        End If

    Else
        Sheets(sayfa_adi).Visible = True
        Sheets(sayfa_adi).Select
    End If

    Exit Sub
atla:
    Target.Offset(1, 0).Select
    MsgBox "Sayfayı Bulamadım."
  
End Sub

.

 

[k0081]

Ömer

Hocam, Type mismatch hatası alıyorum. Dosyayı ekledim.


http://www.dosya.tc/server39/ZG3qnp/Kitap1.rar.html

 

[polis-53]

merhabalar hücreye tıklayınca sayfaya gittiğimde ana sayfaya geri dönüş köprüsünü de oluştursun.

 

[Ömer]

Ömer

Hocam, Type mismatch hatası alıyorum. Dosyayı ekledim.


http://www.dosya.tc/server39/ZG3qnp/Kitap1.rar.html

Virüs hatası verdiği için indiremedim. #6 numaralı mesaja küçük bir ilave yaptım tekrar deneyiniz. Ayrıca sayfada kullandığınız başka kod varsa onları paylaşmanızı rica ederim.

.

 

[Ömer]

merhabalar hücreye tıklayınca sayfaya gittiğimde ana sayfaya geri dönüş köprüsünü de oluştursun.

ThisWorkbook (BuÇalışmaKitabı) sayfasına kopyalayın.

Ana Sayfa A1:A10 arasında çift tıkladığınız hücredeki sayfa adını açar. Açılan sayfada herhangi bir hücreye çift tıklarsanız Ana Sayfaya döner.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, _
            ByVal Target As Range, Cancel As Boolean)
    
    Dim sayfa_adi As String
    
    sayfa_adi = Target.Value
    On Error GoTo atla
    
    If ActiveSheet.Name <> "Ana Sayfa" Then
        Sheets("Ana Sayfa").Select
    Else
        If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
        If Target.Value = "" Then Exit Sub
        Sheets(sayfa_adi).Visible = True
        Sheets(sayfa_adi).Select
    End If
    Exit Sub
atla:
    Target.Offset(1, 0).Select
    MsgBox "Sayfayı Bulamadım."

End Sub

.

 

[k0081]

Ömer;
#5 numaralı mesajda kodu göremedim hocam ?

 

[Ömer]

#6 numaralı mesaja bakınız.

 

[k0081]

Ömer;


hocam yine aynı hatayı veriyor.. type mismatch. Sizin verdiğiniz koddan hariç başka bir kod içermiyor tablo..

* sayfa adını aldıramıyoruz gibi geliyor bana hocam.

http://dosya.co/9xc8nt4djcv6/Kitap1.rar.html

 

[Ömer]

Birleştirilmiş hücre kullandığınız için hata aldınız.

Bu şekilde deneyin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim sayfa_adi As String
    
    If Intersect(Target, Range("B3:B100")) Is Nothing Then Exit Sub

    sayfa_adi = Range("" & Split(Target.Address, ":")(0) & "")
    
    If Range("" & Split(Target.Address, ":")(0) & "") = "" Then Exit Sub
    
    On Error GoTo atla
    Sheets(sayfa_adi).Visible = True
    Sheets(sayfa_adi).Select
    
    Exit Sub
atla:
    Target.Offset(1, 0).Select
    MsgBox "Sayfayı Bulamadım."
    
End Sub

.

 

[k0081]

Ömer;

Hocam çok teşekkür ediyorum tamamdır.. elinize-yüreğinize sağlık..

 

[fırat_raman]

Ömer hocam öncelikle ilgilendiğinizden dolayı teşekkürlerimi sunarım sizin cevabınızı görmeden önce sorduğum soruyla ilgili biraz uğraştım bir şeyler yapmaya çalıştım kodlar farklı çalışmalardan alıntı olduğu için karışık yerleştirmiş olsamda işime yaradı yani biraz acemi işi oldu gibi tekrardan teşekkürlerimi sunarım iyi çalışmalar dilerim

 

[simyaci64]

Arkadaşlar aşağıdaki kod ile anasayfadan şablonu kopyalıyor açılan sayfaya isim verebiliroyuz.
isim verdiğimiz sayfaya aynı anda anasayfaya b1 b100 arasına otomatik isminiköprü nasıl oluşturabiliriz.

Sub YENİ_HESAP_AÇ()
'
' YENİ_HESAP_AÇ Makro
'
Dim sayfa_adi As Variant

sayfa_adi = Application.InputBox("Müşteri Hesap Adını Giriniz")

If sayfa_adi = False Then
MsgBox "İşleminiz iptal edilmiştir.", vbInformation
Exit Sub: End If

If sayfa_adi = "" Then
MsgBox "Lütfen Müşteri Hesap Adını Giriniz. İşleminiz iptal edilmiştir.", vbInformation
Exit Sub: End If

Sheets("SABLON").Copy After:=Sheets(Sheets.Count)

On Error Resume Next
ActiveSheet.Name = sayfa_adi
If Err = 1004 Then
MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

End If

End Sub

 

[Ömer]

Merhaba,

Sheets("SABLON").Copy After:=Sheets(Sheets.Count)

satırından sonra;

Dim son As Long
son = Sheets("anasayfa").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("anasayfa").Cells(son, "B") = sayfa_adi

ActiveSheet.Delete

satırından sonra;

Sheets("anasayfa").Cells(son, "B").ClearContents

satırlarını ekleyin.

.