Soru Hücre değerine göre resim gösterme hk.

[Hakan Ertürk]

Merhabalar,

Ekli dosyadaki excel de Ad Yöneticisi ve formüller ile resim çağırma yapabiliyorum.

Fakat bu resimler bir hayli fazla (100'e yakın) olduğundan dolayı excel çok donuyor. Bu formüllü resim getirme işlemi makroya çevrilebilir mi? (Donmayacağını ve kasmayacağını düşündüğümden dolayı böyle bir arayış içerisine girdim.)

Yardımlarınız için şimdiden teşekkür ederim.

Saygılarımla.
Hakan Ertürk

 

[1ndependent]

Kendinize göre düzenlersiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

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

ActiveSheet.DrawingObjects.Delete

Dim ResimYolu As Variant
Dim resim As Object

For Satır = 3 To 500

ResimYolu = Dir(ActiveWorkbook.Path & "\" & Range("b" & Satır) & ".jpg", vbNormal)

If ResimYolu <> "" Then
Set resim = ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\" & ResimYolu)

With Range("c" & Satır)
resim.Top = .Top + 5
resim.Left = .Left + 20
resim.Height = .Height + 50
resim.Width = .Width - 50

End With
End If

Next Satır

End Sub

 

[Hakan Ertürk]

Günaydın @1ndependent hocam,

Dönüş için teşekkür ederim, VBA yabancı olduğumdan kodlarda hangi satırı düzelteceğimi bilemedim açıkçası.

Web kodlarken;
<title></title> **//Başlık kodudur.
<p></p> **//Paragraf oluşturur. vb. gibi açıklama ekleyip bilgilendiriyoruz.

Buna benzer bir şey yapabilir miyiz? Ne, nedir öğrenmiş olurum veya kaynak gösterebileceğiniz bir doküman var ise oradan da araştırıp VBA'ya bu saye de giriş yapmış olurum.

Saygılarımla.
Hakan Ertürk

 

[Hakan Ertürk]

Merhabalar,

Kodları sayfaya ekledim lakin bir değişim göremedim. Bir yandan da vba öğrenmek istiyorum. Çok geç bile kaldım diyebilirim öğrenmek için. (web tasarım kodlamalarını bildiğim gibi bilmek isterdim vba'yı da)

Konu hakkında tekrar yardımcı olabilir misiniz?

Saygılarımla.

 

[tugkan]

Kendinize göre düzenlersiniz.

Private Sub Worksheet_Change(ByVal Target As Range)

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

ActiveSheet.DrawingObjects.Delete

Dim ResimYolu As Variant
Dim resim As Object

For Satır = 3 To 500

ResimYolu = Dir(ActiveWorkbook.Path & "\" & Range("b" & Satır) & ".jpg", vbNormal)

If ResimYolu <> "" Then
Set resim = ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & "\" & ResimYolu)

With Range("c" & Satır)
resim.Top = .Top + 5
resim.Left = .Left + 20
resim.Height = .Height + 50
resim.Width = .Width - 50

End With
End If

Next Satır

End Sub

Merhaba,

Ben de makrodan çok anlamam ama anladığım kadarıyla B sütunundaki değerlere göre C sütununa resimleri getiriyor. Eğer değerleriniz başka hücredeyse B'leri değiştirebilirsiniz.
Resimlerle excel dosyası aynı klasörde olması gerekiyor.
3 ve 500 satır arasında işlem yapıyor. Değerlerin olduğu satırlara göre bu kısmı da güncelleyebilirsiniz.

 

[Hakan Ertürk]

@tugkan hocam dediğiniz gibi, farklı sütunda değerlerim değiştirdim ancak yine olmadı.

Konu hakkında tam çözüm için yardımcı olabilecek var mıdır?

 

[genesis_vision]

Dosyanız ektedir. Butona basmanız yeterli olacaktır.

 

[1ndependent]

Merhabalar,

Kodları sayfaya ekledim lakin bir değişim göremedim. Bir yandan da vba öğrenmek istiyorum. Çok geç bile kaldım diyebilirim öğrenmek için. (web tasarım kodlamalarını bildiğim gibi bilmek isterdim vba'yı da)

Konu hakkında tekrar yardımcı olabilir misiniz?

Saygılarımla.

Merhaba. @tugkan tam olarak olması gerekenleri aktarmış. B sütunundaki değerlere göre c sütununa resminizi getirir. Bu değerleri kendinize göre değiştirirseniz resimler istediğiniz gibi değeri girdikten sonra kendisi gelecektir. Excel dosyanızı ve resimlerinizin aynı klasörde olması gerekiyor.

Resim boyutları ile ilgili değişiklikleride güncellerseniz bir sorun kalmayacaktır.

Kolay gelsin.

 

[Hakan Ertürk]

Merhaba. @tugkan tam olarak olması gerekenleri aktarmış. B sütunundaki değerlere göre c sütununa resminizi getirir. Bu değerleri kendinize göre değiştirirseniz resimler istediğiniz gibi değeri girdikten sonra kendisi gelecektir. Excel dosyanızı ve resimlerinizin aynı klasörde olması gerekiyor.

Resim boyutları ile ilgili değişiklikleride güncellerseniz bir sorun kalmayacaktır.

Kolay gelsin.

Hocam, aynen sizin dediğiniz ve @tugkan hocamın da dediği gibi sütun değerlerini değiştirdim lakin resimleri ayrıca kaydetmedim, excel içerisinden çekecek diye bekliyordum. Bu sebeple olmamış. Çok teşekkür ederim. Allah razı olsun.

Dosyanız ektedir. Butona basmanız yeterli olacaktır.

Hocam, çok teşekkür ederim. Ayrıca resim taşıma derdim olmayacak. Fakat her butona bastığımda üst üste resimler geliyor bu da dosya boyutunu arttıracak ve de rakamlar formülle değişken değer 1-5 arasında bir değer aldığında resim otomatik değişmiyor. Bu konuda yapılabilecek bir şey var mıdır?

Saygılarımla.

 

[Hakan Ertürk]

Mesajımı düzenleme yapamadığım için tekrar mesaj yazmak zorunda kaldım.

Sub Sil()
With ActiveSheet
For Each HE In .Shapes
If Not Application.Intersect(HE.TopLeftCell, .Range("F3:I50")) Is Nothing Then HE.Delete
Next HE
End With
End Sub

Yukarıdaki kodlar ile "Sil" butonu yaptım.

Resimleri ekliyorum, sayfayı kaydediyorum. Daha sonra "Sil" butonuna basıyorum. Hatasız çalışıyor.

Resimleri ekliyorum, "Sil" butonuna basıyorum 4. satırda "Run time error '1004' // Application-defined or object-defined error" hatası veriyor. [End] dediğimde siliyor resimleri.

* Kaydet yaparak sorunsuz kullanacağım gibi, fakat yine de bir çözümü var ise öğrenmek ister

Destek ve yardımlarınız için çok teşekkür ederim. (Vba'yı da böyle böyle hazır kodlar üzerinden düzenleyerek, ekleme, çıkarma yaparak öğreneceğim inşallah. )

Saygılarımla.
Hakan Ertürk

 

[genesis_vision]

Kodları yeniden düzenledim. Silme işlemi yapmaya gerek kalmadan resimleri getirebilirsin.

 

[Hakan Ertürk]

Kodları yeniden düzenledim. Silme işlemi yapmaya gerek kalmadan resimleri getirebilirsin.

Hocam emeğinize ve ayırdığınız zamana teşekkür ederim. Fakat butona bastıktan sonra, resimlerin bulunduğu hücrelerdeki formüller ve değerler komple siliniyor.

E ve H sütunundaki değerler değiştiğinde haliyle F ve I sütununa yansımadığından buton işlev görmüyor. Tek seferlik çalışan bir buton oldu gibi.