Mail ile Ek ve Detayı Alana Yapıştırma.

[BasitBiri]

Merhaba

Şimdiden değerli cevaplarınız için teşekkür ederim.

Makro ile bazı işlemlerden sonra dosyayı mailde ek'e ekleyebiliyorum fakat bir de göndermiş olduğum excel dosyasını tablet telefonlarından açamayanlar için düz metin veya resim olarak farketmez maile yapıştırma komutunu çok araştırdım fakat bulamadım. Konu hakkında desteğinizi talep ederim.

Teşekkürler.

 

[Asri]

Excel sağ tuş da çıkan bir menü ile bu işlemi her excel dosyasında uygulayabilirsiniz.

http://www.excel.web.tr/f52/excel-ze...u-t157219.html

Eklentinin mail gönderme ile ilgili bölümü

Güncelleme V3.7.1

* Outlook kullanarak mail gönder özelliği eklendi
* Seçili alanı mail gönder
* Sayfayı ek olarak mail gönder
* Çalışma kitabını ek olarak mail gönder

Mail biçimleri seçimi
- HTML olarak
- Salt metin olarak
- Resim olarak

 

[denese]

Merhaba

Şimdiden değerli cevaplarınız için teşekkür ederim.

Makro ile bazı işlemlerden sonra dosyayı mailde ek'e ekleyebiliyorum fakat bir de göndermiş olduğum excel dosyasını tablet telefonlarından açamayanlar için düz metin veya resim olarak farketmez maile yapıştırma komutunu çok araştırdım fakat bulamadım. Konu hakkında desteğinizi talep ederim.

Teşekkürler.

Merhaba,

Eğer yanlış anlamadıysam; excel dosyanızda göndermek istediğiniz alanı seçip Kopyala / Özel Yapıştır / Resim adımlarını izleyerek de, seçili alanı mailinize ekleyebilirsiniz.

 

[BasitBiri]

Konuyu şu şekilde detaylandırmak gerekirse, makrom aşağıdaki gibi fakat ek eklemeden ziyade bu makronun devamı olarak excel içeriğini de maile yapıştırmak istiyorum. Satır Sütun sınırlamam yok tüm sayfayı ve toplam 2 sheet'i yapıştırmak gerekiyor

Attribute VB_Name = "Module1"
Sub HazırRaporV1()
'
' HazırRaporV1 Makro
'
' Klavye Kısayolu: Ctrl+u
'
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("C:E").Select
Selection.Delete Shift:=xlToLeft
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Columns("I:V").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-1]"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G246")
Range("G2:G246").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G7").Select
Application.CutCopyMode = False
Columns("D:F").Select
Selection.Delete Shift:=xlToLeft
Range("D1").Select
ActiveCell.FormulaR1C1 = "Total"
Range("D1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$E$247").AutoFilter Field:=4, Criteria1:="0"
Rows("14:241").Select
Selection.Delete Shift:=xlUp
Range("C217").Select
Selection.AutoFilter
Sheets("YuklenemeyenSiparis").Select
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D").Select
Selection.Delete Shift:=xlToLeft
Sheets("StokRaporu").Select
Range("B10").Select
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
Set rng = Nothing
On Error GoTo 0


With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "halilonuripek@sahra.sansetgida.com.tr"
.CC = "oguzhankaradeniz@sahra.sansetgida.com.tr"
.BCC = ""
.Subject = "Stok Raporu ve Yükelenemeyen Sipariş Raporu"
.Attachments.Add "C:\StokRaporu.xls"
.HTMLBody = "Merhaba, stok raporu ve yüklenemeyen sipariş raporu ekteki gibidir. İyi çalışmalar."
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[BasitBiri]

Tekrar Merhaba

Kodları sonunda buldum ihtiyacı olan için .Body veya .HTMLBody kodlarının altına aşağıdaki kodu yapıştırın ve hafızada o sıra ne varsa onu mailde tablo halinde mail text kısmına yapıştırıyor.

.BodyFormat = 2
Set wrdEdit = OutApp.ActiveInspector.WordEditor
Selection.CopyPicturAe xlPrinter, xlPicture
wrdEdit.Application.Selection.Paste

Bölgeyi hafızayı almak için de şu kodu kullanabilirsiniz.

Sheets("StokRaporu").Range("A1:E205").Copy

Hücreleri değiştirmeyi unutmayın.

Ben kendi mail makromu olduğu gibi paylaşıyorum öğrenecek olanlara eksik kalmasın.

Sheets("StokRaporu").Range("A1:E205").Copy
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
Set rng = Nothing
On Error GoTo 0


With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "deneme@deneme.com "
.CC = "deneme@deneme.com "
.BCC = ""
.Subject = "Stok Raporu, İptal ve Yükelenemeyen Sipariş Raporu"
.Attachments.Add "C:\GunlukRapor.xlsx"
.Body = "Merhaba," & vbCrLf & "Stok raporu, iptal ve yüklenemeyen sipariş raporu ekteki gibidir." & vbCrLf & "1.Sekme - Stok Raporu" & vbCrLf & "2. Sekme - Yüklenemeyen Grafik" & vbCrLf & "3. Sekme - Yüklenemeyen Sipariş" & vbCrLf & "4. Sekme - İptal Grafik" & vbCrLf & "5. Sekme - İptal Raporu" & vbCrLf & "Bu mail otomatik bir şekilde hazırlandığından dolayı bir hata söz konusu olduğu taktirde hata düzeltmesi açısından dönüş yapmanızı rica ederim." & vbCrLf & "Teşekkürler" & vbCrLf & " İyi çalışmalar." & vbCrLf & "Not: Makro deneme aşamasında olduğu için rapora bazı grafikler oluşturuldu ve bunlar deneme amaçlıdır."
.Display ""
.BodyFormat = 2
Set wrdEdit = OutApp.ActiveInspector.WordEditor
Selection.CopyPicturAe xlPrinter, xlPicture
wrdEdit.Application.Selection.Paste
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing