Fotoğraf ekleme

[turgayzeynep]

C1 hücresine iki kez tıkladığımda masa üstünden foto eklemek istiyorum otomatik olarak hücrenin boyutuna göre foto olmasını istiyorum yardımcı olurmusunuz makro ile acil rıca adiyorum

 

[RBozkurt]

Sayfaya sağ tık, kod bölümüne ekleyin
Hata varsa sonra revizyon yaparım.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim filePath As String
    Dim img As Picture
    
    If Target.Address = "$C$1" Then
        Cancel = True
        
        filePath = Application.GetOpenFilename("Resim Dosyaları (*.jpg;*.jpeg;*.gif;*.bmp),*.jpg;*.jpeg;*.gif;*.bmp", , "Resim Seç")
        
        If filePath = "False" Then Exit Sub
        
        Set img = ActiveSheet.Pictures.Insert(filePath)
        
        With img
            .Left = Target.Left ' Resmin sol kenarı hücrenin sol kenarı ile hizalanır
            .Top = Target.Top ' Resmin üst kenarı hücrenin üst kenarı ile hizalanır
            .Width = Target.Width ' Resmin genişliği hücrenin genişliği kadar ayarlanır
            .Height = Target.Height ' Resmin yüksekliği hücrenin yüksekliği kadar ayarlanır
        End With
    End If
End Sub

 

[turgayzeynep]

Hocam teşkkür ederim
Hücrenin boyutuna fotonun taşmaması için ne yapmam lazım

 

[RBozkurt]

With img bölümünü güncelleyerek; Deneyin,

        With img
            .Top = Target.Top ' Resmin üst kenarı hücrenin üst kenarı ile hizalanır
            .Left = Target.Left ' Resmin sol kenarı hücrenin sol kenarı ile hizalanır
            .Width = Target.Width ' Resmin genişliği hücrenin genişliği kadar ayarlanır
            .Height = Target.Height ' Resmin yüksekliği hücrenin yüksekliği kadar ayarlanır
            .Placement = xlMoveAndSize ' Resim, hücrede hareket ettirilir ve boyutlandırılır
            .ShapeRange.LockAspectRatio = msoTrue ' Resmin oranı sabitlenir
            .ShapeRange.Align msoAlignCenters, True ' Resim, hücre içinde dikey olarak ortalanır
            .ShapeRange.Align msoAlignMiddles, True ' Resim, hücre içinde yatay olarak ortalanır
        End With

 

[turgayzeynep]

WİTH İMG
KOMLE SİLİP BUNU YAPIŞTIRDIM HATA VERDİ