Gönderen Konu: VBA Sorusu : 3. Resmi faklı getiremiyorum  (Okunma sayısı 22 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı systemmania

  • Excelce Onbaşı
  • **
  • İleti: 1
  • Puan +0/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
  • Ad Soyad: System Mania
  • Doğum Yılınız: 1990
  • İl / İlçe: İstanbul/Kartal
  • İşletim Sisteminiz: Windows 10
VBA Sorusu : 3. Resmi faklı getiremiyorum
« : 15 Şubat 2020, 13:36:56 »
Merhaba Değerli Arkadaşlar,

Aşağıda paylaşmış olduğum kod ile 2 adet aynı resmi alabiliyorum fakat
3. resmin ismini kod üzerinde belirtmeme rağmen farklı olmasını sağlayamıyorum.
Gözümden kaçan ve hatalı olduğum noktada beni bilgilendirmenizi rica ederim.





Bilgi Notları :
Tür resimler aynı klasör içerisinde.
Tüm resimler aynı formatta.
Resimler numerik olarak sıralı 1.svg, 2.svg, 3.svg…


Kod: [Seç]
Private Sub Worksheet_Change(ByVal Target As Range)

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

On Error GoTo cik

For Each res In ActiveSheet.Pictures
    res.Delete
Next res

Dim ResimYolu As Variant
Dim ResimYolu1 As Variant

Dim Resim1 As Object
ResimYolu = ActiveWorkbook.Path & "\" & Range("I30") & ".svg"
Set Resim1 = ActiveSheet.Pictures.Insert(ResimYolu)
    With Range("I6")
    Resim1.Top = 89.37480315
    Resim1.Height = 80
    Resim1.Left = .Left
    Resim1.Width = 80
      End With

Dim Resim2 As Object
Set Resim2 = ActiveSheet.Pictures.Insert(ResimYolu)
    With Range("I19")
    Resim2.Top = 226.37480315
    Resim2.Height = 80
    Resim2.Left = .Left
    Resim2.Width = 80
        End With
             
Dim Resim3 As Object
ResimYolu1 = ActiveWorkbook.Path & "\" & Range("I30") & "1.svg"
Set Resim3 = ActiveSheet.Pictures.Insert(ResimYolu1)
    With Range("B8")
    Resim3.Top = .Top
    Resim3.Height = 80
    Resim3.Left = .Left
    Resim3.Width = 80
        End With
   
cik:
End Sub