Sayfadaki resmin kaynağını değiştirme.

[Kardiyak]

Sub deneme2()
pertc = "12345678901"
Set kls = CreateObject("Scripting.FileSystemObject")
varmıd = kls.FileExists(ThisWorkbook.Path & "\Foto\" & pertc & ".jpg")
If varmıd = True Then
    ActiveSheet.Shapes("Foto").Picture = LoadPicture(ThisWorkbook.Path & "\Foto\" & pertc & ".jpg")
    Else
     ActiveSheet.Shapes("Foto").Picture = LoadPicture(ThisWorkbook.Path & "\Foto\00.jpg")
    End If
End Sub

yukarıdaki kod ile sayfada bulunan "Foto" isimli shapedeki resmi değiştirmek istiyorum fakat ActiveSheet.Shapes("Foto").Picture kısmında
"runtime error: 438
Object doesn't support this propery or methot "hatası alıyorum.

ActiveSheet.Shapes("Foto").select yazdığımda hata vermiyor.
Forumu araştırdım fakat istediğim yanıtı bulamadım.
yeni resim eklemeden olan Foto resminin kaynağını değiştirmem gerekiyor. Resme sağ tıklayıp resmi değiştir dediğimde makro kaydında bir şey oluşmuyor.

 

[Kardiyak]

Sayfadaki resmi sildim yerine bir dikdörtgen ekleyip kodu şu şekilde değiştirdim.

Sub deneme2()
pertc = "12345678901"
Set kls = CreateObject("Scripting.FileSystemObject")
varmıd = kls.FileExists(ThisWorkbook.Path & "\Foto\" & pertc & ".jpg")
If varmıd = True Then
    ActiveSheet.Shapes("Foto").Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture ThisWorkbook.Path & "\Foto\" & pertc & ".jpg"
        .TextureTile = msoFalse
    End With
Else
    ActiveSheet.Shapes("Foto").Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture ThisWorkbook.Path & "\Foto\00.jpg"
        .TextureTile = msoFalse
    End With
End If
End Sub

şimdilik işimi görüyor. Resim biçimlendirmede kenarlık kalınlaştıkça resmin dışına doğru büyürken dikdörtgende kenarlık kenarlık merkezden hem içe hemde dışa büyüyor. Biraz görsellik kaybı ile şimdilik işimi görüyor.