Klasörden Resim Çağırma Kodu Sorunu

Katılım
20 Ocak 2020
Mesajlar
22
Excel Vers. ve Dili
Türkçe Professional Plus 2010
Arkadaşlar Merhaba,

Şirketin Proforma Invoicesi için excelde Geliştirici Modundan "Klasörden Resim Çağırma" kodu eklemesi yaptım. Kod başarıyla çalıştı seçtiğim ürünlerin resmi istediğim gibi çıkıyor fakat aynı excel içerisinde şirketin logosu gibi bazı resimler sabit durmuyor. excelin her hangi bir noktasına tıkladığımda sabit durmasını istediğim resimler kayboluyor. Bunun için nasıl çözüm bulabilirim ?

Eklediğim kod;

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

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

'hata kontrolü
On Error GoTo çıkış
' Resimleri Sil

ActiveSheet.DrawingObjects.Delete
'Resim yolunun bulunması

Dim ResimYolu As Variant
Dim Resim As Object

For satır = 14 To 22

ResimYolu = ActiveWorkbook.Path & "\" & Range("b" & satır) & ".jpg"

' Resmi oluştur
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)

'Resmi Boyutlandır

With Range("c" & satır)
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With

Next satır

çıkış:
End Sub
 
Katılım
20 Ocak 2020
Mesajlar
22
Excel Vers. ve Dili
Türkçe Professional Plus 2010
Yardımcı olursanız sevinirim. Bu kod çalışırken şirketin logosu sabit kalsın istiyorum. İlgili dosyanın her hangi bir yerine tıklayınca sabit durmasını istediğim resimler gidiyor. Sadece kodda klasörden çağırmasını istediğim resimler yükleniyor.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,757
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
örnek dosyanız olmadığından bir yorum yapmak zor
ama bu bölüm sayfadaki bütün resimleri siler,
ActiveSheet.DrawingObjects.Delete
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Sn Halit3 'ün belirttiği kodlarınızın içindeki

ActiveSheet.DrawingObjects.Delete
'Resim yolunun bulunması


yerine

Kod:
For Each x In ActiveSheet.Shapes
If Not Intersect(x.TopLeftCell, Range("C1:C100")) Is Nothing Then
x.Delete
End If
Next x
"Range("C1:C100")" satır aralığını ayarlayın
 
Katılım
20 Ocak 2020
Mesajlar
22
Excel Vers. ve Dili
Türkçe Professional Plus 2010
rkadaşlar öncelikle cevaplar için teşekkür ederim. Dosya ekleyi bulamadım ilgili makro dosyasını link olarak ekledim http://www.stopgrup.om/example.xlsm

Resimle tarif etmek gerekirse C14 den C20 ye kadar seçilebilir resimler tanımladım. Oralarda yukarıda vermiş olduğum kodlarla resimler sorunsuz çıkıyor. Fakat en yukarda solda şirket logomuz var. Sabit olarak durmuyor. Her hangi bir yere tıkladığımda kayboluyor. İlgili dosyayıda ekledim. Yardımcı olursanız sevinirim.
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Ek dosyayı deneyiniz "B14:B20" aralığında veri (resim adı) seçildiğinde "C" hücresine resim getirecektir, "B" hücresi boşaltıldığında karşısındaki resim
silinecek
https://dosyaup.com/d/BRWVWFG
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B14:B20")) Is Nothing Then Exit Sub
Dim ResimYolu As Variant
Dim Resim As Object
'hata kontrolü
'On Error GoTo çıkış
If Target.Value = "" Then
For Each x In ActiveSheet.Shapes
If Val(x.Top) = Val(Range("C" & Target.Row).Top) Then
x.Delete
End If
Next x
Else
ResimYolu = ActiveWorkbook.Path & "\" & Target.Value & ".jpg"
If Dir(ResimYolu) <> "" Then
Set Resim = ActiveSheet.Pictures.Insert(ResimYolu)
With Range("c" & Target.Row)
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
Resim.Top = .Top
End With
Else
MsgBox "Resim Bulunamadı"
End If: End If
çıkış:
End Sub
 
Katılım
20 Ocak 2020
Mesajlar
22
Excel Vers. ve Dili
Türkçe Professional Plus 2010
Cevaplarınız çok yardımcı oldu teşekkür ederim. Bir sorum daha olacaktı resim çağırma kodunda resimler ilgili excel ile aynı dizinde olunca görünüyor. Aynı klasör içinde(index kısmı) resimlerin /resimler klasörü içinden çağrılmasını nasıl sağlayabilirim ?
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Kodların içinde; "Resimyolu" tanımını değiştirmeniz yeterli olacaktır
Kod:
ResimYolu = ActiveWorkbook.Path & "\resimler\" & Target.Value & ".jpg"
 
Katılım
20 Ocak 2020
Mesajlar
22
Excel Vers. ve Dili
Türkçe Professional Plus 2010
Merhaba
Kodların içinde; "Resimyolu" tanımını değiştirmeniz yeterli olacaktır
Kod:
ResimYolu = ActiveWorkbook.Path & "\resimler\" & Target.Value & ".jpg"
Bu kodu kullandığımda resimde ki hatayı alıyorum nasıl çözebilirim ? bir klasör içerisinde ilgili excel var onun bulunduğu klasörde /resimler diye klasör açtım. Oradan resimleri çekmedi.

 
Katılım
7 Haziran 2012
Mesajlar
1
Excel Vers. ve Dili
2007 türkçe
Selam Arkadaşlar benim sorunum şu
Excelde bilirkişi raporu hazırladığım bir program yazdım. Vba kullanmadan yazdım. Bu programda rapor sayfasında p7 hücresine hangi dosya numarasini girsem b82:k82 arasına uydu isimli klasörden p7 deki dosya numarası kaç ise o numara ile aynı numaralı resmi getirsin. yine P7 ye girdiğim dosya numarası kaç ise B281:k281 arasına ise bu programında içinde bulunduğu Resimli isimli klasördeki keşif fotoğrafını getirsin şimdiden sağolun tesekkuler kilci@enginner.com adresine atabilirseniz kodu çok iyi olur dostlar.
 
Üst