Skip i'r prif gynnwys

Sut i gludo ystod o gelloedd i mewn i gorff negeseuon fel delwedd yn Excel?

Os oes angen i chi gopïo ystod o gelloedd a'i gludo fel delwedd i mewn i gorff negeseuon pan fyddwch chi'n anfon e-bost gan Excel. Sut allech chi ddelio â'r dasg hon?

Gludwch ystod o gelloedd i mewn i gorff e-bost fel delwedd gyda chod VBA yn Excel


Gludwch ystod o gelloedd i mewn i gorff e-bost fel delwedd gyda chod VBA yn Excel

Efallai nad oes dull da arall i chi ddatrys y swydd hon, gall cod VBA yn yr erthygl hon eich helpu chi. Gwnewch fel hyn:

1. Galluogi'r ddalen rydych chi am ei chopïo a gludo'r celloedd fel delwedd, daliwch y ALT + F11 allweddi i agor y Microsoft Visual Basic ar gyfer Ceisiadau ffenestr.

2. Cliciwch Mewnosod > Modiwlau, a gludwch y cod canlynol yn y Modiwlau Ffenestr.

Cod VBA: pastiwch ystod o gelloedd i mewn i gorff e-bost fel delwedd:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the data range:", "KuTools for Excel", Selection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
    TempFilePath = Environ$("temp") & "\"
    xHTMLBody = "<span LANG=EN>" _
            & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
            & "Hello, this is the data range that you want:<br> " _
            & "<br>" _
            & "<img src='//cdn.extendoffice.com/cid:DashboardFile.jpg'>" _
            & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
      .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
        .To = " "
        .Cc = " "
        .Display
    End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    Dim xShape As Shape
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        For Each xShape In ActiveSheet.Shapes
            xShape.Line.Visible = msoFalse
        Next
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
   Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

Nodyn: Yn y cod uchod, gallwch newid cynnwys y corff a'r cyfeiriad e-bost i'ch angen.

3. Ar ôl mewnosod y cod, pwyswch F5 yn allweddol i redeg y cod hwn, mae blwch deialog wedi'i popio allan i'ch atgoffa rhag dewis yr ystod ddata rydych chi am ei mewnosod yn y corff e-bost fel llun, gweler y screenshot:

4. Yna cliciwch OK botwm, ac a Neges ffenestr yn cael ei harddangos, mae'r ystod ddata a ddewiswyd wedi'i mewnosod yn y corff fel delwedd, gweler y screenshot:

Nodyn: Yn y Neges ffenestr, gallwch hefyd newid cynnwys y corff a chyfeiriadau E-bost ym meysydd To a Cc yn ôl yr angen.

5. O'r diwedd, cliciwch anfon botwm i anfon yr e-bost hwn.


Nodyn: Os oes angen i chi gludo ystodau lluosog o wahanol daflenni gwaith, gall y cod VBA isod ffafrio chi:

Yn gyntaf, dylech ddewis yr ystodau lluosog rydych chi am eu mewnosod yn y corff e-bost fel lluniau, ac yna defnyddio'r cod canlynol:

Cod VBA: pastiwch ystodau lluosog o gelloedd i'r corff e-bost fel delwedd:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    Dim xSheet As Worksheet
    Dim xAcSheet As Worksheet
    Dim xFileName As String
    Dim xSrc As String
    On Error Resume Next
    TempFilePath = Environ$("temp") & "\RangePic\"
    If Len(VBA.Dir(TempFilePath, vbDirectory)) = False Then
      VBA.MkDir TempFilePath
    End If
    Set xAcSheet = Application.ActiveSheet
    For Each xSheet In Application.Worksheets
        xSheet.Activate
        Set xRg = xSheet.Application.Selection
        If xRg.Cells.Count > 1 Then
            Call createJpg(xSheet.Name, xRg.Address, "DashboardFile" & VBA.Trim(VBA.Str(xSheet.Index)))
        End If
    Next
    xAcSheet.Activate
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    xSrc = ""
    xFileName = Dir(TempFilePath & "*.*")
    Do While xFileName <> ""
        xSrc = xSrc + VBA.vbCrLf + "<img src='cid:" + xFileName + "'><br>"
        xFileName = Dir
        If xFileName = "" Then Exit Do
    Loop
    xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & xSrc _
                & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
        xFileName = Dir(TempFilePath & "*.*")
        Do While xFileName <> ""
            .Attachments.Add TempFilePath & xFileName, olByValue
            xFileName = Dir
        If xFileName = "" Then Exit Do
        Loop
        .To = " "
        .Cc = " "
       .Display
    End With
    If VBA.Dir(TempFilePath & "*.*") <> "" Then
        VBA.Kill TempFilePath & "*.*"
    End If
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\RangePic\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

Offer Cynhyrchiant Swyddfa Gorau

🤖 Kutools AI Aide: Chwyldro dadansoddi data yn seiliedig ar: Cyflawniad Deallus   |  Cynhyrchu Cod  |  Creu Fformiwlâu Personol  |  Dadansoddi Data a Chynhyrchu Siartiau  |  Invoke Swyddogaethau Kutools...
Nodweddion Poblogaidd: Darganfod, Amlygu neu Adnabod Dyblygiadau   |  Dileu Rhesi Gwag   |  Cyfuno Colofnau neu Gelloedd heb Colli Data   |   Rownd heb Fformiwla ...
Super-edrych: VLookup Meini Prawf Lluosog    VLookup Gwerth Lluosog  |   VLookup Ar Draws Taflenni Lluosog   |   Edrych Niwlog ....
Rhestr gwympo Uwch: Creu Rhestr Gollwng yn Gyflym   |  Rhestr Gollwng Dibynnol   |  Rhestr Gollwng Aml-ddewis ....
Rheolwr Colofn: Ychwanegu Nifer Penodol o Golofnau  |  Symud Colofnau  |  Toglo Statws Gwelededd Colofnau Cudd  |  Cymharwch Ystodau a Cholofnau ...
Nodweddion dan Sylw: Ffocws ar y Grid   |  Golwg Dylunio   |   Bar Fformiwla Mawr    Rheolwr Llyfr Gwaith a Thaflen   |  Llyfrgell Adnoddau (Testun Auto)   |  Dewiswr Dyddiad   |  Cyfuno Taflenni Gwaith   |  Amgryptio/Dadgryptio Celloedd    Anfon E-byst trwy Restr   |  Hidlo Super   |   Hidlo Arbennig (hidlo mewn print trwm/italig/strikethrough...) ...
15 Set Offer Gorau12 Testun offer (Ychwanegu Testun, Dileu Cymeriadau,...)   |   50 + Siart Mathau (Siart Gantt,...)   |   40+ Ymarferol Fformiwlâu (Cyfrifwch oedran yn seiliedig ar ben-blwydd,...)   |   19 mewnosod offer (Mewnosod Cod QR, Mewnosod Llun o'r Llwybr,...)   |   12 Trosi offer (Rhifau i Eiriau, Trosi arian cyfred,...)   |   7 Uno a Hollti offer (Rhesi Cyfuno Uwch, Celloedd Hollt,...)   |   ... a mwy

Supercharge Eich Sgiliau Excel gyda Kutools ar gyfer Excel, a Phrofiad Effeithlonrwydd Fel Erioed Erioed. Kutools ar gyfer Excel Yn Cynnig Dros 300 o Nodweddion Uwch i Hybu Cynhyrchiant ac Arbed Amser.  Cliciwch Yma i Gael Y Nodwedd Sydd Ei Angen Y Mwyaf...

Disgrifiad


Mae Office Tab yn dod â rhyngwyneb Tabbed i Office, ac yn Gwneud Eich Gwaith yn Haws o lawer

  • Galluogi golygu a darllen tabbed yn Word, Excel, PowerPoint, Cyhoeddwr, Mynediad, Visio a Phrosiect.
  • Agor a chreu dogfennau lluosog mewn tabiau newydd o'r un ffenestr, yn hytrach nag mewn ffenestri newydd.
  • Yn cynyddu eich cynhyrchiant 50%, ac yn lleihau cannoedd o gliciau llygoden i chi bob dydd!
Comments (42)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello! The posted code above works great although its bringing along the grid lines from the Excel sheet into the email even though I shut off the visible gridlines in the sheet.. Is there a way to exclude these gridlines? Thank you!!
This comment was minimized by the moderator on the site
Thanks it really great helpful. can u pls help me to auto attached the sheet also while sending the mail  
This comment was minimized by the moderator on the site
Hi, Where I should paste my range for correct function this code.I have still the same range.Thanks for help - Damian.PS. This is´ great
This comment was minimized by the moderator on the site
This method is perfect but I'm unable to take email ids from range. Is there any specific reason ?
This comment was minimized by the moderator on the site
Suggestions for including the default email signature?
This comment was minimized by the moderator on the site
Hi, the macro keep pasting the old image and not the new one, bow can i fix it? If i past Manually it works thanks
This comment was minimized by the moderator on the site
Is there a way to change the name of the JPG file from DashboardFile?
This comment was minimized by the moderator on the site
Thank You, it works great :-)
This comment was minimized by the moderator on the site
Hi, I also have the error that the generated file stays in the temp and isn't being overwritten...
This comment was minimized by the moderator on the site
Hello,
First of all thank you for your work, but I have an issue with it. It seems that the Jpg generated named Dashboardfile stays in temp and the macro always use the same jpg in the email.
Maybe i miss something here. Hope you can help me.
Thank you
Gaëtan
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations