logolar oluşturulan mail gövdesine gelmemekte

redwhitewolf

Altın Üye
Katılım
18 Mayıs 2017
Mesajlar
6
Excel Vers. ve Dili
Office 365 pro
Altın Üyelik Bitiş Tarihi
30-06-2027
Öncelikle İyi günler diliyorum.
Sitenizi ilgiyle takip ediyorum.
Sitede emeği geçen herkese sonsuz teşekkürler.

Benim sorunum eklemiş olduğum dosyada belirlenen hücre aralığını mail atma makrosunda
belirlenen alanda ( b26:gh34 ve ı26:n34 bandında) yer alan (image) logolar oluşturulan mail gövdesine gelmemekte ;

Kod:
Sub Banka_Durumu()
'Office 2000-2010 sürümlerinde çalışır
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets("Mail").Range("ı2:n34").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If rng Is Nothing Then
       MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Banka Durumu"
        .HTMLBody = RangetoHTML(rng)
        .Display   'göndermek için .Send
    End With
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Sorunu acaba nasıl çözerim.
Yardımlarınız için şimdiden teşekkürler.
 

Ekli dosyalar

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Buradaki excel dosyasını inceleyiniz.

http://asriakdeniz.com/excel-dogum-gunu-mail-ile-kutlama/

Belirli bir alanı JPG ye çeviren kod.
Kullanımı Call createJpg("Kart", "C2:O30", isimstr)


Kod:
Sub createJpg(Namesheet As String, nameRange As String, nameFile)
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile, "JPG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
    Set Plage = Nothing
End Sub
 

redwhitewolf

Altın Üye
Katılım
18 Mayıs 2017
Mesajlar
6
Excel Vers. ve Dili
Office 365 pro
Altın Üyelik Bitiş Tarihi
30-06-2027
dediğiniz kodu nereye yapıştıracağım?
commond buton atadım çalışmadı
 

redwhitewolf

Altın Üye
Katılım
18 Mayıs 2017
Mesajlar
6
Excel Vers. ve Dili
Office 365 pro
Altın Üyelik Bitiş Tarihi
30-06-2027
üstadım dosyayı denedim
çalışıyor çok teşekkür ediyorum.Sağ olunuz.
sadece sıkıntım şu
eklediğim jpeg görüntüsünde görüldüğü üzere
logo için belirlediğiniz alanın etrafında çizgi oluşturmakta,
bunu nasıl çizgisiz oluşturabiliriz
 

Ekli dosyalar

Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
üstadım dosyayı denedim
çalışıyor çok teşekkür ediyorum.Sağ olunuz.
sadece sıkıntım şu
eklediğim jpeg görüntüsünde görüldüğü üzere
logo için belirlediğiniz alanın etrafında çizgi oluşturmakta,
bunu nasıl çizgisiz oluşturabiliriz
Excel deki görüntü resim olarak alındığı zaman çerçeve gibi izi kalıyor.
Biçimlendirme ve kesim alanlarını değiştirmeyi denedim ama çizgilerin tamamı yok olmadı.

Çözüm bulan biri çıkabilir.
 
Üst