Arkadaşlar merhaba; Daha önce yine sizlerin yardımıyla Çift tıklamayla hücreye çağrılan resmi hücre boyutuna otomatik sığdıran aşağıdaki kod çok işime yaramıştı. Yanılmıyorsam Sayın Tahsin Hocam yazmıştı. Emeği geçenlere teşekkürler.
Şimdi ise bir excel sayfasına eklenmiş olan bir resmi Sağ tık kopyala yapıştır şeklinde alıp başka bir sayfadaki seçili hücreye yapıştırırken resim boyutu otomatik olarak hücre boyutuna ayarlanabilir mi? Bunun için nasıl bir kod yazmak gerekir acaba? Yardımcı olabilirseniz sevinirim. Saygılar.
Sayın Tahsin Hocamın yazdığı kod ihtiyacı olanlar için aşağıdadır.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sPicture As String, pic As Picture
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.png; *.tif), *.gif; *.jpg; *.bmp; *.png; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 0).MergeArea.Height
.Width = Target.Offset(0, 0).MergeArea.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Range("F1").Select
End Sub
Şimdi ise bir excel sayfasına eklenmiş olan bir resmi Sağ tık kopyala yapıştır şeklinde alıp başka bir sayfadaki seçili hücreye yapıştırırken resim boyutu otomatik olarak hücre boyutuna ayarlanabilir mi? Bunun için nasıl bir kod yazmak gerekir acaba? Yardımcı olabilirseniz sevinirim. Saygılar.
Sayın Tahsin Hocamın yazdığı kod ihtiyacı olanlar için aşağıdadır.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sPicture As String, pic As Picture
sPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.png; *.tif), *.gif; *.jpg; *.bmp; *.png; *.tif", _
, "Select Picture to Import")
If sPicture = "False" Then Exit Sub
Set pic = ActiveSheet.Pictures.Insert(sPicture)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 0).MergeArea.Height
.Width = Target.Offset(0, 0).MergeArea.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Range("F1").Select
End Sub