makroda çoklu köprüleme yaptığım jpeg dosyalarını görüntüleme

[masue]

merhaba arkadaslar;

makroda jpeg dosyalarıma excelden köprü oluşturdum.fakat excelde ilgili hücreye bastığımda sadece ilgili klasörü açabiliyorum.ben hedef olan ürüne(jpeg)excelde bastığımda klasörden aynı isimli dosyayı seçip görüntülemek istiyorum.yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.iyi çalışmalar

Sub kopruekle()
For i = 1 To [ı65536].End(3).Row
ActiveSheet.Hyperlinks.Add Anchor:=Range("ı" & i), Address:="C:\Users\Erdal\Desktop\resim", SubAddress:= _
"Sayfa2!" & ("ı" & i), TextToDisplay:=Range("ı" & i).Text
Next
End Sub

 

[masue]

arkadaşlar daha hızlı bir çözüabilmesi için örnek dosyamı link olarak ekliyorum.
http://dosya.co/lgt20syt166u/resim.rar.html

 

[alicimri]

Köprü oluşturmanıza gerek yok. I Sütununda, uzantısız olarak resim klasörünüzde bulunan .jpg dosyalarınızın adlarını listeleyiniz. Aşağıdaki kodu yine ilgili sayfanızın modülüne yapıştırın, eğer I sütununda herhangi bir hücresinde çift tıkladığınızda hücredeki metin resim klasörünüzde aynı isimli dosya ile eşleşiyorsa o resim dosyası açılır.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 9 Then
If Dir("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg") <> "" Then
Dim Shex As Object
   Set Shex = CreateObject("Shell.Application")
   Shex.Open ("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg")
End If
End If
End Sub

 

[masue]

Hocam elinize emeğinize sağlık çok teşekkür ederim.

 

[masue]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 9 Then
If Dir("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg") <> "" Then
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open ("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg")
End If
End If
End Sub

bu kod dahilinde ulaştığım jpg dosyasını otomatik yazdırabilirmiyim.Ctrl+p ekranına kadar gelebilirmiyim.

 

[alicimri]

Yazıcım yok deneyemedim.

Private Declare Function ShellExecute _
        Lib "shell32.dll" Alias "ShellExecuteA" _
            (ByVal hwnd As Long, _
             ByVal lpOperation As String, _
             ByVal lpFile As String, _
             ByVal lpParameters As String, _
             ByVal lpDirectory As String, _
            ByVal nShowCmd As Long) _
        As Long
Private Const SW_HIDE = 0
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 9 Then
If Dir("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg") <> "" Then
Dim Shex As Object
Set Shex = CreateObject("Shell.Application")
Shex.Open ("C:\Users\Erdal\Desktop\resim\" & Target & ".jpg")
yaz = ShellExecute(0, "Print", "C:\Users\Erdal\Desktop\resim\" & Target & ".jpg", 0, 0, SW_HIDE)
End If
End If
End Sub

 

[masue]

çok teşekkürler hocam.sorunsuz çalışıyor.