Doubleclickle hücredeki link ile web sayfası açmak

[mersilen]

Merhabalar

Doubleclickle W sütunundaki hücreyi tıkladığımda aynı satırdaki E hücresindeki linkin açılmasını nasıl sağlarım.Bunu aşağıdaki kodun içine monte etmek gerekiyor.

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

If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then Exit Sub

say = WorksheetFunction.Match(CDbl(Date), Rows(1), 0)
 
With Cells(Target.Row, say)
    .Value = Format(Now, "hh")
    .Interior.ColorIndex = 3
End With
 
End Sub

 

[Ömer]

Merhabalar

Doubleclickle W sütunundaki hücreyi tıkladığımda aynı satırdaki E hücresindeki linkin açılmasını nasıl sağlarım.Bunu aşağıdaki kodun içine monte etmek gerekiyor.

Merhaba,

Bu şekilde deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Dim say As Integer
 
    If Intersect(Target, [C20:C2000,W20:W2000]) Is Nothing Then Exit Sub
    say = WorksheetFunction.Match(CDbl(Date), Rows(1), 0)
 
    With Cells(Target.Row, say)
        .Value = Format(Now, "hh")
        .Interior.ColorIndex = 3
    End With
 
[COLOR=royalblue]    If Target.Column = 23 Then[/COLOR]
[COLOR=royalblue]        Shell "explorer.exe http://" & Cells(Target.Row, "E"), 1[/COLOR]
[COLOR=royalblue]    End If[/COLOR]
 
End Sub

.

 

[mersilen]

Ömer bey hayırlı bayramlar
cevap içinde teşekkür ederim.

Kod çalışmadı
explorer açılıyor ama geçersiz söz dizimi hatası veriyor
http://05:276:07/

firefox.exe ilede açılabilir mi?
Denedim olmadı.

 

[Ömer]

Eklediğiniz dosyadayı yeni gördüm.

Dosyada web sitesi değil, köprü fonksiyonu varmış. Eklediğiniz dosyadaki köprü olan hücrelere tıklayınca açılan nedir?

.

 

[mersilen]

Aslında ekran görüntüsünü eklemek isterdim ama hastane ortamında bir sorun var ekletmiyor
Onun yerine bendeki sistemin minyatürünü yapıp ekledim
Linke tıklayınca kor klasörünün içindeki web dosyasını çalıştırıyor (firefox ile açınca tüm tıklamalar aynı pencerede yeni sekme olarak açılmakta .. /..ama explorerda tüm mükerrer tıklamalar her defasında yeni pencereler olarak gelmekte)
Açılan web sayfasındaki butonada tıklayınca sistem çalışmakta (istediğim bilgiyi server a göndermekte), burda şimdilik sorun yok
ben doubleclickle hamle sayımı azaltıyım, zamandan tasarruf edeyim diye düşünmüştüm; zamana bağlı üretim miktarını belirlemeyi başardım, bunuda daha sonra kodun altına ekleyeceğim.

 

[mersilen]

Tekrar merhaba Ömer bey
Deneme yanılma yoluyla birşeyler yaptım
Firefox açılmakta, ama her tıklamaktaki yolu ayarlayamadım

Shell "C:\Program Files\Mozilla firefox\firefox " & "file:///F:/hhttmm/hhttmm-son/kor/(_WANTED_).13.414.06.html", vbMaximizedFocus



Bir konuda benzer uygulama yapmışlar ama anlayamadım
http://www.excel.web.tr/f48/butonla-dosya-acmak-t25326/sayfa2.html

shell app.path & "\UygulamaAdı.exe" şeklinde yazdığımız zaman aynı dizindeyse açılıyor aynı dizinde değilse shell app.path & "dosya yolu-dosya adı" şeklinde yazdığımız zaman açılmıyor bunu nasıl yapabiliriz

http://www.picproje.org/index.php?topic=29541.0

Shell ("notepad.exe " & App.Path & "\dosya.txt")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Dim say As Integer
 
    If Intersect(Target, [C20:C2000,W20:W2000]) Is Nothing Then Exit Sub
    say = WorksheetFunction.Match(CDbl(Date), Rows(1), 0)
 
    With Cells(Target.Row, say)
        .Value = Format(Now, "hh")
        .Interior.ColorIndex = 3
    End With
 
    If Target.Column = 23 Then
       ' Shell "explorer.exe " & Cells(Target.Row, "E").Value, 1
       
         Shell "C:\Program Files\Mozilla firefox\firefox " & "file:///F:/hhttmm/hhttmm-son/kor/(_WANTED_).13.414.06.html", vbMaximizedFocus
    End If
End Sub

Sanırım aşağıdaki kodu düzenlemek yeterli olacak

Application.ThisWorkbook.FollowHyperlink Address:="kor\" & Cells(Target.Row, "D").Value & ".html"

 

[mersilen]

Tekrar merhabalar

sorunumu aşağıdaki şekilde çözdüm

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
If Intersect(Target, [C20:C2000,w20:w2000]) Is Nothing Then Exit Sub
 
say = WorksheetFunction.Match(CDbl(Date), Rows(1), 0)
 
With Cells(Target.Row, say)
    .Value = Format(Now, "hh")
    .Interior.ColorIndex = 3
End With

    If Target.Column = 23 Then
       ' Shell "explorer.exe " & Cells(Target.Row, "E").Value, 1

 Application.ThisWorkbook.FollowHyperlink Address:="kor\" & Cells(Target.Row, "D").Value & ".html"
   End If
  End Sub