Actif hücre değiştikçe UserFormdaki resmin değişimi

[okyanus123452]

Actif hücre değiştikçe UserFormdaki resmin değişimi (Çözüldü)

Merhabalar
Elimde yaklaşık 1400 soru var.
Her bir sorunun kodu var. (Örneğin 01*02*09; …. ; 05*04*22 vb)
Bu kodlar Excel sayfasının C sütununda tanımlı.
Bir CommandButon yapılacak ve bu buton UserForm1’i açacak.
Bu Formda Eğer;
i) Aktif hücre C sütünunda veri olan bir yerde ise hemen o sorunun resmi formda gözükecek.
ii) Aktif hücre C sütununda ama veri yoksa yada C stunundan başka bir yerde ise formda resim gözükmeyecek.

Olayı daha iyi anlatır jpeg dosyası ektedir.

İlginize şimdiden teşekkür eder, çalışmalarınızda kolaylıklar dilerim.
Saygılarımla.

 

[bedersu]

Sayın okyanus123452,
Resim yerine dosya ekleseniz cevap daha net olurdu ama aşağıdaki kodlar sanırım işinize yarar:

Private Sub UserForm_Initialize()
a = ActiveCell.Column
    If ActiveCell.Column = 3 Then
    
   veri = Replace(ActiveCell, "*", "")
    
    Image1.Picture = LoadPicture("C:\sorular\veri" & ".jpg")
End If
End Sub

 

[Necdet]

Merhaba,

Alternatif olsun.

Modul1 deki kodlar, bu kodları bir butonla ilişkilendiriniz.
UserForm1 deki kodları da kendi dosyanıza uyarlayınız.

Not : Aktif hücre değerindeki "*" karakterleri silinerek sonuna ".jpg" eklenerek dosya getirilmektedir.

Sub FormAc()
 
    UserForm1.Show
 
End Sub

UserForm_Initialize a ait kodlar :

Private Sub UserForm_Initialize()
 
    On Error Resume Next
 
    Dim Yol     As String
    Dim Dosya   As String
 
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya = Replace(ActiveCell.Value, "*", "")
 
    Image1.Picture = LoadPicture(Yol & Dosya & ".jpg")
 
End Sub

 

[okyanus123452]

Sayın bedersu ve Sayın Necdet Yeşertener
Soruma istinaden yazdığınız kodları içeren yazınızı teşekkürle aldım. Kodları şimdi deneyeceğim. İlginize tekrar tekrar teşekkürlerimi sunarım.

 

[okyanus123452]

Sayın bedersu ve Sayın Necdet Yeşertener

1) Kodlarınızı inceledim her ikiside çalışıyor. Yapmak istediğim tam bu değildi ama buda işimi görüyor.
2) Bu durumun kuvvetle muhtemel sorunu benim tam olarak ifade edememem den kaynaklandığını düşünüyorum.
3) Eğer fazla zamanınızı almayacaksa, sizlere büyük bir yük getirmeyecekse asıl yapmak istediğim olaya uygun olarak tekrar kodları değiştirme olanağınız olabilir mi?
4) Şuan ki durum ve asıl yapmak istediğim durumu kısaca aşağıdaki gibi belirteyim.
Şuan ki durum:
Aktif hücrenin Örneğin C1216 da (ve değeri 06*04*06) olduğunu düşünelim. Bu durumda ben sayfadaki "KODA ÖRE SORU ÖNİZLEMSİNİ YAP" butonuna bastığımda ilgili yoldaki jpeg dosyasını bana form gösteriyor. Buraya kadar Sorun yok.
Ancak ben hemen altındaki C1217 de (ve değeri 06*04*07) ki sorunun önizlemesini yapmak istediğimde açık formu önce kapatım sonra tekrar açmam gerekiyor.Bu durumda doğru jpg dosyasınıda gösteriyor.Ancak
İSTEDİĞİM DURUM: Ben formu kapatıp açmaya gerek duymadan hemen aktif hücre değişince hemen o formdaki resim yani jpeg dosyasıda değişşin.

Bilmem anlatabildim mi?

5) Tekrarlamakta fayda görüyorum. Göstermiş olduğunuz samimi ilgiye ve affınıza istinaden tekrar yazma gereksinimi duydum.

6) Örnek Excel dosyasını ve bir kaç jpeg dosyasını ekte bulabilirsiniz.

Saygılarımla,

 

[bedersu]

sayın okyanus123452,
şu kodları dener misiniz?

Private Sub Worksheet_selectionChange(ByVal Target As Range)
    On Error Resume Next
    Dim Yol     As String
    Dim Dosya   As String

If Intersect(Target, Range("C4:C" & [C65536].End(3).Row)) Is Nothing Then Exit Sub
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Dosya = Replace(ActiveCell.Value, "*", "")
UserForm1.Image1.Picture = LoadPicture("D:\Sorular\" & Dosya & ".jpg")

End Sub

 

[halit3]

Alternatif kod
Kodu sayfanın kod bölümüne yapıştırın.

Private Sub Worksheet_selectionChange(ByVal Target As Range)
Dim Yol As String, Dosya As String, Uzanti(3)
Uzanti(1) = "bmp": Uzanti(2) = "jpg": Uzanti(3) = "gif"
UserForm1.Image1.Picture = LoadPicture(None)
If Intersect(Target, Range("C4:C" & [C65536].End(3).Row)) Is Nothing Then Exit Sub
Yol = ThisWorkbook.Path & Application.PathSeparator
Dosya = Replace(ActiveCell.Value, "*", "")
For i = 1 To 3
resimyükle = Yol & Dosya & "." & Uzanti(Val(i))
If CreateObject("Scripting.FileSystemObject").FileExists(resimyükle) = True Then
UserForm1.Image1.Picture = LoadPicture(resimyükle)
Exit For
End If
Next i
End Sub

not : dosya ve resimler aynı klasörde olmalı

 

[okyanus123452]

ÇÖZÜLDÜ (Actif hücre değiştikçe UserFormdaki resmin değişimi)

Sayın Bedersu ve Halit ÖZDEMİR
Son gönderdiğiniz kodları denedim her ikisi de istediğim gibi sorunsuz bir biçimde çalıştı.

Tekrar tekrar Emeği geçen herkese teşekkürlerimi sunarım.
Saygılarımla