Question

我没有使用Excel vba，但到目前为止使用此网站已完成。

所以我设法创建了我想要发送电子邮件的表格，并创建了我想发送给读者的电子邮件，但我仍然坚持如何将图表作为图片附加（我已经将其作为图片创建在新工作表中我将发送的工作簿）并将相同的Excel工作簿附加到电子邮件中，以完成电子邮件并准备发送。

这是我走了多远：

Sub LFL_makrosu()

'select&copy&paste from sheet to another

'find last row  on sheet

    Dim lRow As Long
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'first copy&paste

    Sheets("Sheet1").Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'USE CORRECT CELLS ON BELOW CODE

    Range("A2:B" & lRow).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Sheet4").Select

'USE CORRECT CELLS ON BELOW CODE

    Range("A2").Select
    ActiveSheet.Paste

'second copy&paste

    Sheets("Sheet2").Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'USE CORRECT CELLS ON BELOW CODE

    Range("A2:B" & lRow).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'USE CORRECT CELLS ON BELOW CODE

    Range("A" & lRow + 2).Select
    ActiveSheet.Paste

'third copy&paste

    Sheets("Sheet3").Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'USE CORRECT CELLS ON BELOW CODE

    Range("A2:B" & lRow).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    lRow = Cells(Rows.Count, 1).End(xlUp).Row

'USE CORRECT CELLS ON BELOW CODE

    Range("A" & lRow + 2).Select
    ActiveSheet.Paste

'create the table and email

    Call Snapshotandsendmail

    End Sub

Sub Snapshotandsendmail()
' Snapshot Macro

     Dim lRow As Long
     lRow = Cells(Rows.Count, 1).End(xlUp).Row

'start creating mail and the table as picture

     Dim wb As ThisWorkbook
     Set wb = ThisWorkbook

     Dim ws As Worksheet
     Set ws = wb.Sheets("Sheet4")

     Dim rng  As Range
     Set rng = ws.Range("A2:D18")
     rng.CopyPicture

     Dim CH As Chart
     Set CH = Charts.Add

     CH.Location xlLocationAsObject, "Sheet4"
     Set CH = ActiveChart
     ActiveChart.Parent.Name = "Final_Tablo"
     ActiveSheet.ChartObjects("Final_Tablo").Height = rng.Height
     ActiveSheet.ChartObjects("Final_Tablo").Width = rng.Width
     rng.CopyPicture xlScreen, xlBitmap
     CH.Paste

     Call sendemail

End Sub

Sub sendemail()

'create the email on outlook

     Dim olook As Outlook.Application
     Set olook = New Outlook.Application
     Dim omail As Outlook.MailItem
     Set omail = olook.CreateItem(olMailItem)

     With omail
     .Display
     End With
     Signature = omail.HTMLBody

     Dim fldName1 As String
     fldName1 = Path & Gun & ".xlsx"

'creates the  message on the Email from given date to today - 2

     With omail
     .To = "deniz.beser@koctas.com.tr"
     .CC = "deniz.beser@koctas.com.tr"
     .Subject = "LFL Karşılaştırması"
     .HTMLBody = "<BODY style=font-size:11pt;font-family:calibri>Merhaba, <p>" & "01.01.2017 - 0" & DateAdd("d", -2, Date) & " tarih aralığını içeren; günlük LFL, Koçtaş All Stores Satış & CM & BM% ve bütçe karşılaştırmasını ekte bilgilerinize sunarız.<p>" & vbNewLine & Signature
'.Save

     .Display

'.Send

     End With

     Set omail = Nothing
     Set olook = Nothing
     Set olAtt = Nothing

End Sub

将工作簿中的文件和图表附加到excel vba创建的电子邮件中

0 个答案: