semih001
Altın Üye
- Katılım
- 6 Şubat 2024
- Mesajlar
- 22
- Excel Vers. ve Dili
- 2013
- Altın Üyelik Bitiş Tarihi
- 02-06-2025
Selam kolay gelsin. Aşağıdaki kodu yazdım fakat kod çalışmıyor. Yardımcı olabilecek var mı acaba ?
İstediğim şey e3 hücresine bir sayı yazdığımda ( 3000 e kadar) "\\metsanqnap\üretim ve planlama\Semih\Ürün Resimleri" klasöründen o sayının olduğu resimleri çekmesi.
Resimler .jpg ve .png formatlarında. formülü kullanacağım excel sayfasının ismi " Öngörü " , Excelin adı ise " Termin Planlama "
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3]) Is Nothing Then Exit Sub
On Error GoTo Git
Dim ResimYolu As Variant
Dim "\\metsanqnap\üretim ve planlama\Metsanindex\ÜRÜN RESİMLERİ" As Object
Dim S1 As Worksheet
Set S1 = Sheets("Öngörü")
S1.DrawingObjects.Delete
ResimYolu = ActiveWorkbook.Path & "\" & Range("E3") & ".jpg"
Set Resim = S1.Pictures.Insert(ResimYolu)
With S1.Range("BL20:BR30")
Resim.ShapeRange.LockAspectRatio = msoFalse
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Git:
End Sub
İstediğim şey e3 hücresine bir sayı yazdığımda ( 3000 e kadar) "\\metsanqnap\üretim ve planlama\Semih\Ürün Resimleri" klasöründen o sayının olduğu resimleri çekmesi.
Resimler .jpg ve .png formatlarında. formülü kullanacağım excel sayfasının ismi " Öngörü " , Excelin adı ise " Termin Planlama "
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E3]) Is Nothing Then Exit Sub
On Error GoTo Git
Dim ResimYolu As Variant
Dim "\\metsanqnap\üretim ve planlama\Metsanindex\ÜRÜN RESİMLERİ" As Object
Dim S1 As Worksheet
Set S1 = Sheets("Öngörü")
S1.DrawingObjects.Delete
ResimYolu = ActiveWorkbook.Path & "\" & Range("E3") & ".jpg"
Set Resim = S1.Pictures.Insert(ResimYolu)
With S1.Range("BL20:BR30")
Resim.ShapeRange.LockAspectRatio = msoFalse
Resim.Top = .Top
Resim.Left = .Left
Resim.Height = .Height
Resim.Width = .Width
End With
Git:
End Sub