ayrı klasörlerde bulunan dosyalardan excele kritere göre resim getirme makrosu nasıl yapılır?

[KMLZDMR]

Merhaba,
Excel2003 kullanıcısıyım.
Ekli dosyadaki işlemde aynı klasör içinde excel dosyası ve resimler bulunmakta excel sayfasında ilgili alana kritere göre seçilen resim gelmektedir. Bunu

adresinden yapabildim. Ekli dosya buna ilişkin örnektir. Dosya adı: "Fproforma"
Ancak, benim yapmam gereken işlemde excel dosyasının bulundu alan ayrı kalsörde (iç içe dosyalarda) ='D:\kemalpen\Belgekml\Bezir2018\GKB\[üyetakip.xls]BZRpaysen!$R$13 'de ; resimlerin bulunduğu dosya dizisi ise 'D:\kemalpen\Belgekml\Bezir2018\üyeiş\Üyeresim deki Üyeresim dosya içerisinde bulunmaktadır.

"Fproforma" dosya içerisindeki makro: aşağıdadır. worksheet - change

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d3]) Is Nothing Then Exit Sub
'kullnılmıyor bu satır deneme içindi Range("a4") = "mehmet"
'HATA KONTROLÜ
On Error GoTo Çıkış
' resimleri sil
ActiveSheet.DrawingObjects.Delete
'resim yolunun bulunması
Dim ResimYolu As Variant
Dim Resim As Object
'ResimYolu = ActiveWorkbook.Path & "\" & "2.jpg"
ResimYolu = ActiveWorkbook.Path & "\" & Range("d3") & ".jpg"
' Resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
' resmi boyutlandır
With Range("d5")
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Çıkış:
End Sub

yapmak istediğim taslak makro da aşağıdadır. Yapılmasını talep ettiğim konuyu aşağıdaki makroda nasıl düzenlenmesi gerekir. Teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)

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

On Error GoTo Çıkış

ActiveSheet.DrawingObjects.Delete

Dim ResimYolu As Variant

Dim Resim As Object

' aşağıdaki satırda ... "ActiveWorkbook.Path" aktif kitap yerine sarı alandaki yolu makroya nasıl uyarlarız. Amacım resim gelecek alanın bulunduğu diğer kitap içindeki excel dosyasının ilgili sayfasına resmi yapıştırması... 'D:\kemalpen\Belgekml\Bezir2018\üyeiş\Üyeresim

ResimYolu = ActiveWorkbook.Path & "\" & Range("AE27") & ".jpg"

'aşağıdaki r13 hücresine "resim" isimli ad ekledim. ad- "resim" başvuru yeri =BZRpaysen!$R$13

='D:\kemalpen\Belgekml\Bezir2018\GKB\[üyetakip.xls]BZRpaysen!$R$13 şeklinde olup

BZRpaysen AE27 hücresindeki kritere göre resim gelecek


Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

With Range("R13")

Resim.Top = .Top

Resim.Left = .Left

Resim.Height = .Height

Resim.Width = .Width

End With

Çıkış:

End Sub

 

[askm]

ResimYolu = "D:\kemalpen\Belgekml\Bezir2018\üyeiş\Üyeresim\" & Range("d3") & ".jpg"
şeklinde yazarsanız belirttiğiniz adresten gelir.

 

[KMLZDMR]

Sayın askm malesef olmadı...

 

[Ömer BARAN]

Merhaba Sayın ÖZDEMİR.

Bence iki ayrı belge ekleyin (bunlardan biri resimin yapıştırılacağı belge diğeri de resim kaynağının bulunduğu belge)
Ardından da belgelerdeki ilgili hücrelerin yanına da, kısa ve net olacak şekilde BURADAN / BURAYA gibi not ekleyin.

Yalnız;
-- resimin kaynağı olan gerçek belgenin dosya yolunun,
-- resimin kaynağı olan belgedeki hücrenin adresi, başka bir hücreden alınacaksa bu hücrenin bulunduğu sayfa adı/hücre adresinin,
-- hem resim kaynağı belge ve hem de resimin yapıştırılacağı belgedeki sayfa isimlerinin ve hücre adreslerinin
gerçek belgelerdeki ile aynı olmasına özen gösterin.

Örnek belge olmadan verilecek cevapların ihtiyacı tam olarak karşılamaması normal.
.