Makro ile Hücredeki metin adına sahip klasörü çift tıkla açmak

[ermanusta]

Merhabalar,

B1 hücresinde sabit anaklasör yolu var bu klasörün altında A stünundaki metin adlarına sahip ayrı klasörler var
yapmak istediğim
A stünundaki dolu hücrelere çift tıkladığımda o hücredeki metin adına sahip (B1 ana klasör altındaki) klasörü açmak

makro ile olması gerekiyor forumda aradım ama tam olarak bulamadım, yardımcı olabilir misiniz?

 

[Astalavista58]

Merhaba, çift tıklama ile değilde bir butona atayarak işlemi yapabilirsin. Secili hücredeki dosyayı açar.

Sub KlasorAc()
    Dim AnaKlasor As String
    Dim MetinAdi As String
    Dim KlasorYolu As String

    AnaKlasor = ActiveSheet.Range("B1").Value

    MetinAdi = ActiveCell.Value

    If MetinAdi = "" Or Not TypeName(ActiveCell) = "Range" Then
        Exit Sub
    End If

    KlasorYolu = AnaKlasor & "\" & MetinAdi

    If Dir(KlasorYolu, vbDirectory) <> "" Then
        Shell "explorer.exe " & KlasorYolu, vbNormalFocus
    Else
        MsgBox "Klasör bulunamadı: " & KlasorYolu, vbExclamation
    End If
End Sub

 

[ermanusta]

Teşekkür ederim, ama bunu her hücre üzerine ayrı ayrı bir buton eklemek çok daha uzun zaman alır,
acaba bunu sayfa içerisinde belirli stündaki hücrelere çift tıkladığımda çalışacak şekilde düzenleyebilir miyiz ?


Sub KlasorAc()
Dim AnaKlasor As String
Dim MetinAdi As String
Dim KlasorYolu As String

AnaKlasor = ActiveSheet.Range("B1").Value

MetinAdi = ActiveCell.Value

If MetinAdi = "" Or Not TypeName(ActiveCell) = "Range" Then
Exit Sub
End If

KlasorYolu = AnaKlasor & "\" & MetinAdi

If Dir(KlasorYolu, vbDirectory) <> "" Then
Shell "explorer.exe " & KlasorYolu, vbNormalFocus
Else
MsgBox "Klasör bulunamadı: " & KlasorYolu, vbExclamation
End If
End Sub

 

[alicimri]

Kodlarınızı ilgili sayfanın kod modülünü Sekme adının üzerinde sağ tıklayıp Kod Görüntüle ye tıklayın

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

event ine yapıştırın

 

[ermanusta]

Kodlarınızı ilgili sayfanın kod modülünü Sekme adının üzerinde sağ tıklayıp Kod Görüntüle ye tıklayın

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

event ine yapıştırın

Dediğinizi yaptım fakat başka bir sayfada bir hücreye çift tıklama makrosuyla çakışıyor

If Intersect(Target, Sheets("Sayfa1").[Q:Q]) Is Nothing Then Exit Sub

 

[alicimri]

If Intersect(Target, [Q:Q]) Is Nothing Then Exit Sub

Satırındaki "Sayfa1", kodu yazdığınız sayfa mı?
"Sheets("Sayfa1")." silerek deneyin

 

[ermanusta]

If Intersect(Target, [Q:Q]) Is Nothing Then Exit Sub

Satırındaki "Sayfa1", kodu yazdığınız sayfa mı?
"Sheets("Sayfa1")." silerek deneyin

Hayır Sayfa1 de çift tıklamayla başka bir komutu yerine getiren bir makro var.
Ben şu an Sayfa2 de çift tıklamayla köprü komutunu elde etmek istiyorum. bir önceki arkadaşın verdiği koda sizinkisini uyarladığımda sayfa1 deki makro ile çakışarak hata veriyor. ilk defa başka bir sayfadaki kodla çakışma gördüm, nedenini anlayamadım.