Excele Makro ile resim kayıt etme

[crpzz37]

Selamunaleyküm

Arkadaşlar benim bir excel vba çalışmam var onun içerisinde aşağıdaki kod ile worksheet üzerine resim ekliyorum. Daha sonra bu exceli başka birine mail yolu ile ilettiğimde resimler gözükmüyor bağlantı yolu hatası vererek örnek aşağıda. Ancak ben boş bir excel açık içerisine Ekle>Bu bilgisayardan diyerek bir resim eklediğimde ve bu exceli kayıt edip başka birine gönderdiğimde bu resimler excelin içine yerleşerek iletiliyor.

Bu durumu nasıl düzeltebilirim lütfen yardımcı olursanız sevinirim.

Resimleri Excel sayfasına eklediğim kod
Private Sub Label24_Click()
Dim picName As Variant
Dim picPath As String
Dim picWidth As Double
Dim picHeight As Double

'Dosya seçme iletişim kutusunu aç
picName = Application.GetOpenFilename("JPG,*.jpg,PNG,*.png,GIF,*.gif", , "Select Picture")

'Eğer bir dosya seçilmediyse, makro işlem yapmaz
If picName = False Then Exit Sub

'Seçilen dosyanIn adInI ve yolu al
picPath = picName

'Resmin boyutlarInI ayarla
picWidth = 200 'resim genişliği
picHeight = 200 'resim yüksekliği

'Resmi Sheet1'in A1 hücresine ekle
With Sheets("Sheet1").Pictures.Insert(picPath)
.Left = Sheets("Sheet1").Range("m3").Left + 5
.Top = Sheets("Sheet1").Range("m3").Top + 15
.Width = picWidth
.Height = picHeight
.Placement = xlFreeFloating
End With

ThisWorkbook.Save
MsgBox ("Resim Eklendi"), vbInformation, "Resim Ekleme"
End Sub

Almış olduğum hata

 

[RBozkurt]

İlk mesaja mail gönderdiğiniz kodu da ekleyiniz, yardımcı olunacaktır.

 

[crpzz37]

İlgimiz için teşekkürler. Kod ile mail olarak atmıyorum masaüstüne farklı bir excel olarak kayıt ediyorum ancak sorunu aşağıdaki gibi Shape nesne olarak ekleyince çözdüm tekrar ilginiz için çok sağolun.

Private Sub Label24_Click()
    Dim picName As Variant
    Dim picPath As String
    Dim picWidth As Double
    Dim picHeight As Double
    Dim picShape As Shape
    
    'Dosya seçme iletişim kutusunu aç
    picName = Application.GetOpenFilename("JPG,*.jpg,PNG,*.png,GIF,*.gif", , "Select Picture")
    
    'Eğer bir dosya seçilmediyse, makro işlem yapmaz
    If picName = False Then Exit Sub
    
    'Seçilen dosyanIn adInI ve yolu al
    picPath = picName
    
    'Resmin boyutlarInI ayarla
    picWidth = 200 'resim genişliği
    picHeight = 200 'resim yüksekliği
    
    'Resmi Sheet1'in A1 hücresine ekle
    Set picShape = Sheets("Sheet1").Shapes.AddPicture(Filename:=picName, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=Sheets("Sheet1").Range("m3").Left + 5, _
        Top:=Sheets("Sheet1").Range("m3").Top + 15, _
        Width:=picWidth, _
        Height:=picHeight)

    ThisWorkbook.Save
    MsgBox ("Resim Eklendi"), vbInformation, "Resim Ekleme"
End Sub

 

[Muzaffer Ali]

Merhaba.

İkinci paylaştığınız koddaki gibi eklerseniz sorun yaşamazsınız.

Set picShape = Sheets("Sheet1").Shapes.AddPicture(Filename:=picName, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoTrue, _
        Left:=Sheets("Sheet1").Range("m3").Left + 5, _
        Top:=Sheets("Sheet1").Range("m3").Top + 15, _
        Width:=picWidth, _
        Height:=picHeight)