Hücredeki Değere Göre Resmin boyutunun değişmesi

[baydeniro]

Merhaba Arkadaşlar
Excel dosyasındaki resimlerin boyutunun hücredeki sayıya göre orantısal olarak değişmesi mümkün mü ?
Örnek dosya linki > https://yadi.sk/i/DwAvmW82iumK7w

 

[Seyit Tiken]

Örnek dosyayı inceleyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Shapes("Resim 9").Height = [g2]
Target.Select
End Sub

 

[EmrExcel16]

Bende , alternatif olması açısından bir dosya hazırladım.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hucre, Resim
    If Not Intersect(Target, [B2], [I2]) Is Nothing Then Exit Sub
    Set Hucre = Target.Offset(1, -1)
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Hucre) Is Nothing Then
            Resim.ShapeRange.LockAspectRatio = msoFalse
            Resim.Height = Target * 3.8
            Resim.Width = Target * 3.8
        End If
    Next Resim
End Sub

 

[baydeniro]

Örnek dosyayı inceleyebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Shapes("Resim 9").Height = [g2]
Target.Select
End Sub

SeyitTiken üstadım çok teşekkür ederim. Harika bir kod. Çok kryifli işler yapacağız. Sağlıcakla kalın

 

[baydeniro]

Bende , alternatif olması açısından bir dosya hazırladım.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hucre, Resim
    If Not Intersect(Target, [B2], [I2]) Is Nothing Then Exit Sub
    Set Hucre = Target.Offset(1, -1)
    For Each Resim In ActiveSheet.Pictures
        If Not Intersect(Resim.TopLeftCell, Hucre) Is Nothing Then
            Resim.ShapeRange.LockAspectRatio = msoFalse
            Resim.Height = Target * 3.8
            Resim.Width = Target * 3.8
        End If
    Next Resim
End Sub

EmrExcel16 üstadım, harika bir alternatif kod oldu, çok teşekkür ederim. Sağlıcakla kalın

 

[EmrExcel16]

EmrExcel16 üstadım, harika bir alternatif kod oldu, çok teşekkür ederim. Sağlıcakla kalın

Rica ederim , iyi çalışmalar.