• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Yardım Mailde body'ye hücre aralığı yazmak,subject kısmını formülle alma

Gökhan Tomar

Yeni Üye
Katılım
13 Haz 2018
Mesajlar
2
En iyi yanıt
0
Puanları
3
Konum
İstanbul
Merhabalar,

Aşağıdaki kodlara göre

1- Subject kısmını formül ile almam gerekiyor. Formülüm =BİRLEŞTİR(A1;"- ";SOLDAN(B3;12))
bunu makroda nasıl yazabilirim.
2- body kısmında şu şekilde yazmasını istiyorum,

Gökhan Bey; (ardından)
A1:G38 aralığını mailin içine kopyalamam gerekiyor.

İyi çalışmalar dilerim.
-------------------
Sub Email_Gonder()

Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
On Error Resume Next
With Mail
.To = "gokhan.tomar@anadolukimya.com"
.CC = "gokhantomar@gmail.com"
.Subject = "Ortalama Vade Hesaplama-"
.Body = "Gökhan Bey;"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set Mail = Nothing
Set Makro = Nothing
End Sub
 

Ekli dosyalar

  • deneme konf..xlsm
    29.3 KB · Görüntüleme: 5

Murat OSMA

Yönetici
Site Yöneticisi
Katılım
25 May 2018
Mesajlar
1,506
En iyi yanıt
13
Puanları
113
Konum
İstanbul
Web sitesi
excelarsivi.com
Ad Soyad
Murat OSMA
Office Vers.
Office 365 TR+EN
Subject kısmı için; Sheets(1).Range("A1").Value & "-" & Left(Sheets(1).Range("B3").Value, 12)

Email_Gonder makrosunu bu şekilde değiştirin.

PHP:
Sub Email_Gonder()
    Dim Makro As Object, Mail As Object
    Set Makro = CreateObject("Outlook.Application")
    Set Mail = Makro.CreateItem(0)
    Dim rng As Range
    Set rng = Nothing
    Set rng = Sheets(1).Range("A1:G38")
    On Error Resume Next
    With Mail
        .To = "gokhan.tomar@anadolukimya.com"
        .CC = "gokhantomar@gmail.com"
        .Subject = Sheets(1).Range("A1").Value & "-" & Left(Sheets(1).Range("B3").Value, 12)
        .HTMLBody = RangetoHTML(rng)
        '.Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    On Error GoTo 0
    Set Mail = Nothing: Set Makro = Nothing
End Sub

FunctionModule adında bir module ekleyin ve içine bu kodları yapıştırın.. istediğiniz olacaktır.

PHP:
Option Explicit
Function RangetoHTML(rng As Range)
    'Office 2000-2019 sürümlerinde çalışır
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
     TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Kopya aralığı ve geçmiş verileri yeni bir çalışma kitabı oluşturamazsınız
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Sayfayı htm dosyası olarak yayınla
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'RangetoHTML içine htm dosyası olan tüm verileri oku
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
     'TempWB'yi kapat
    TempWB.Close savechanges:=False
    'htm dosyası olan bu fonksiyonu sil
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Üst Alt