Excel Hücreye Yazdığımız Parça Koduna Göre O Koda Ait Resmi Excel Sayfasına Otomatik Getirmek...

Makonun çalışma prensibi;

Parça kodunu yazıp enter tuşuna basıldığında otomatik olarak istediğiniz hücreye o parçanın resmini getirir.İlk olarak yapmanız gereken parçaların resmini içeren bir klasör oluşturmak.Ve her resmin adı o resme ait parça kodu ile tanımlanmalı. (Hücreye yazdığımız parça kodu ile eşleşmesi için)

1-Öncelikle makroyu aşağıdaki gibi ana sayfamıza ait sheet e tıklayıp içine yapıştırıyoruz. 

2-Sonra kırmızı ile işaretlediğim hücre isimlerine sizin parçanızın yazılacağı hücre ismini yazınız.

3-Akabinde Turuncu işaretlediğim L2 yazan yeri resmin gelmesini istediğiniz hücre adı ile değiştiriniz.

4-Son olarak Resim dosya kısmındaki adres linkini daha önceden oluşturduğumuz resim klasörüne ait link ile değiştiriniz.resmin boyutunu ayarlamak isterseniz en alt satırda yer alan Height kısmını yükseltip düşürebilirsiniz.

MACRO:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$J$3" Then Exit Sub Mamul End Sub Sub Mamul() ActiveSheet.Pictures.Delete Dim ResimDosya As String ResimDosya = "\\BURAYA RESİM KLASÖRÜNE AİT LİNKİ KOYUNUZ\" & [J3] & ".jpg" InsertPicturInRange ResimDosya End Sub Sub InsertPicturInRange(PictureFileName1 As String) '---- , TargetCells As Range ' inserts a picture and resizes it to fit the TargetCells range Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub Set p = Nothing If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub If Dir(PictureFileName1) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName1) ' determine positions ' With TargetCells With [L2] t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With ' position picture With p .Top = t .Left = l .Width = w .Height = 139 End With Set p = Nothing End Sub