Sayfaya resim çağırma

[M.ACAR]

İyi geceler,Hayırlı ramazanlar

Aşağıda yazılı kod ile B sütununa malzemeyi yazdığımda malzemeye ait resimi buluyor,fakat Resim 1,Resim 2,Resim 3 ekleme yaptım,eklediğim resimleri bulmuyor hata veriyor;
mevcut resimler arasında geçiş yaparken resimlerin hepsini gösterip aranılan resmi öyle buluyor,yani resimlerin hepsi arasında geçiş yapmadan istenilen resmi getirse bununla ilgili kod için yardımcı olursanız sevinirim.



Private Sub
Worksheet_SelectionChange(ByVal Target As Excel.Range)
Select Case ActiveCell.Column
Case 2 To 3
If ActiveCell.Row > 18 And ActiveCell.Row < 10000 Then
deneme = Cells(ActiveCell.Row, 2) 'ActiveCell.Value
Cells(1, 1) = deneme
arm = ActiveCell.Address
Select Case deneme
Case "DÜZ KANAL"
ActiveSheet.Shapes("Resim 27").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "DİRSEK"
ActiveSheet.Shapes("Resim 22").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "REDÜKSİYON"
ActiveSheet.Shapes("Resim 26").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "ES PARÇASI"
ActiveSheet.Shapes("Resim 23").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "KOLLEKTÖR-1"
ActiveSheet.Shapes("Resim 20").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "KOLLEKTÖR-2"
ActiveSheet.Shapes("Resim 25").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "KOLLEKTÖR-3"
ActiveSheet.Shapes("Resim 13").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "KAPAK"
ActiveSheet.Shapes("Resim 24").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "DERECE"
ActiveSheet.Shapes("Resim 21").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "ADAPTÖR"
ActiveSheet.Shapes("Resim 1").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "SAPLAMA"
ActiveSheet.Shapes("Resim 2").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
Case "MANŞONLUKAPAK"
ActiveSheet.Shapes("Resim 3").Select
Selection.ShapeRange.ZOrder msoBringToFront
Range(arm).Select
End Select
End If
If Intersect(Target, [A2:A65536]) Is Nothing Then Exit Sub
Target.Offset(0, 1) = "=DATEDIF(RC[-1],R1C2,""y"")"
End Select 'Select Case ActiveCell.Column
End Sub

 

[M.ACAR]

Dosyayı ekleyemiyorum,dosya boyutunu nasıl küçültebilirim.

 

[M.ACAR]

Dosyayı ekleyemiyorum,dosya boyutunu nasıl küçültebilirim.

 

[M.ACAR]

Sorun çözülmüştür,Resim adlarında hata yapmışım düzenledim,sorun çözülmüştür.

 

[omerceri]

Sn M.ACAR
Resim (Shape) isimleri ile malzeme isimleri aynı olursa daha esnek bir çalışma olur diye düşünüyorum. Her yeni resim veya malzeme için kodları değiştirmezsiniz.

 

[mancubus]

zamanında üstadlarının dediği gibi: "tasarım kodlamadan önce gelir."