Tip: andere talen zijn Google-Vertaald. Je kunt het English versie van deze link.
Log in
x
or
x
x
Registreren
x

or

Hoe plak je een reeks cellen in het bericht in beeld als in Excel?

Als u een reeks cellen moet kopiëren en als een afbeelding in de berichttekst wilt plakken wanneer u een e-mail vanuit Excel verzendt. Hoe kon je met deze taak omgaan?

Plak een bereik van cellen in e-mail body als afbeelding met VBA-code in Excel


Plak een bereik van cellen in e-mail body als afbeelding met VBA-code in Excel


Misschien is er geen andere goede methode voor u om deze taak op te lossen, een VBA-code in dit artikel kan u helpen. Doe alsjeblieft als volgt:

1. Schakel het blad in dat u wilt kopiëren en plak de cellen als afbeelding, houd de knop ingedrukt ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Klikken bijvoegsel > moduleen plak de volgende code in de module Venster.

VBA-code: plak een bereik van cellen in de hoofdtekst van de e-mail als afbeelding:

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='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

Notes: In de bovenstaande code kunt u de hoofdtekstinhoud en het e-mailadres aanpassen aan uw behoefte.

3. Na het invoegen van de code, druk op F5 om deze code uit te voeren, wordt een dialoogvenster weergegeven om u eraan te herinneren dat u het gegevensbereik selecteert dat u als afbeelding in de e-mail wilt opnemen, zie screenshot:

4. Dan klikken OK knop en a Bericht venster wordt weergegeven, is het geselecteerde gegevensbereik als afbeelding in de body ingevoegd, zie screenshot:

Notes: In de Bericht venster kunt u de inhoud van het hoofdgedeelte en de e-mailadressen in de velden Aan en Cc naar behoefte wijzigen.

5. Klik ten slotte op Verstuur om deze e-mail te verzenden.


Notes: Als u meerdere bereiken van verschillende werkbladen wilt plakken, kan de onderstaande VBA-code u een plezier doen:

Eerst moet u de meerdere bereiken selecteren die u als afbeeldingen in de e-mail wilt invoegen en vervolgens de volgende code toepassen:

VBA-code: plak meerdere reeksen cellen in de hoofdtekst van de e-mail als afbeelding:

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

Kutools voor Excel - De beste Office-productiviteitstool Verhoog uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Coderen van cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula Bar (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken op gefilterd bereik...
  • Cellen / rijen / kolommen samenvoegen zonder gegevens te verliezen; Inhoud gesplitste cellen; Combineer dubbele rijen / kolommen... voorkomen dubbele cellen; Ranges vergelijken...
  • Selecteer Dupliceren of Uniek rijen; Selecteer Lege rijen (alle cellen zijn leeg); Super Find en Fuzzy Find in veel werkboeken; Willekeurig selecteren ...
  • Exacte kopie Meerdere cellen zonder formule-referentie te wijzigen; Automatisch referenties maken naar meerdere vellen; Voeg kogels toe, Selectievakjes en meer ...
  • extract Text, Tekst toevoegen, verwijderen op positie, Verwijder de spatie; Subtotalen voor paging maken en afdrukken; Converteren tussen cellen Inhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerde sortering per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functionaliteit 60-daagse gratis proefversie.
kte-tab 201905

Tabblad Office Brengt interface met tabbladen naar Office en maakt uw werk veel eenvoudiger

  • Bewerken en lezen met tabbladen inschakelen in Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster, in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en verlaagt dagelijks honderden muisklikken voor u!
Officetab onderaan
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Carlos · 4 days ago
    When I try to send a second email with the same rage but diffent info (is a pivot) is showing the 1st image on the second email. How do I delete the image after created or pasted on email?
  • To post as a guest, your comment is unpublished.
    Breaking bad · 23 days ago
    Join the club, even I am facing the same issue ,with borders around the image .
    .
    .
    Waiting for a fix.

    Fingers crossed !!!!
    • To post as a guest, your comment is unpublished.
      skyyang · 23 days ago
      Hello, Breaking,
      The code in this article has been updated, please try, hope it can help you!
      Thank you!
  • To post as a guest, your comment is unpublished.
    srilatha aithal · 23 days ago
    Hi
    This works great. But it has a border around the image. Is there a way to take this off.


    Thank you
    • To post as a guest, your comment is unpublished.
      skyyang · 23 days ago
      Hello, srilatha,
      The code in this article has been updated, please try, hope it can help you!
      Thank you!
      • To post as a guest, your comment is unpublished.
        srilatha aithal · 22 days ago
        This is awesome. Thanks a heap


        I got one last problem, my image appears a little blur and that happens only in one column .Any way to fix that.

        Thank you!!
  • To post as a guest, your comment is unpublished.
    Saisri · 23 days ago
    Hi,
    This works great, but has a border. Is there a way to remove the border
  • To post as a guest, your comment is unpublished.
    NoMadMax59 · 1 months ago
    Buongiorno,
    l'esecuzione del codice si ferma a xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss) e torna alla sub sendMail senza creare l'immagine.

    Utilizzo Office 2010 e win7

    Come posso correggere?
  • To post as a guest, your comment is unpublished.
    Jackie · 2 months ago
    Hi Skyyang, can you let me have the code for sending two ranges from two sheets of the same work sheet, each range in a different image?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 months ago
      Hello, Jackie,
      I have updated this article, you can use the code at the end of this article.
      Please try, hope it can help you!
      • To post as a guest, your comment is unpublished.
        Jackie · 2 months ago
        Sorry, never mind. It's my mistake on my part. One more question - how can I add a space in between the images?
        • To post as a guest, your comment is unpublished.
          skyyang · 2 months ago
          Hi, Jackie,
          To insert a blank row between the images, you just need to press Enter key at the end of the image in the email body.
      • To post as a guest, your comment is unpublished.
        Jackie · 2 months ago
        Hi skyyang, thank you very much. It works, for the most part. However, I have different ranges ("F1:N15") from sheet 1, and "H1:N15" from sheet 2. It seems always use the "F1:N15" range from both sheets. How can I make it change 2 different ranges?
  • To post as a guest, your comment is unpublished.
    Jose Goncales · 4 months ago
    This is amazing. One question: How can I send two ranges that are in two differents sheets of the same workbook, each range in a different image?
    • To post as a guest, your comment is unpublished.
      skyyang · 2 months ago
      Hi, Jose,
      The code is somewhat difficult, and it can not insert here, if you want to this code, you can give your email here, and i will send the code to your email.
      Thank you!
  • To post as a guest, your comment is unpublished.
    Jose Gonçalves · 4 months ago
    This is awesome!! Can you tell me how I can insert more than one image using this code? I need insert two interval of the same workbook, but they are in diferents sheets.
  • To post as a guest, your comment is unpublished.
    dadd · 4 months ago
    buongiorno… potreste dirmi cosa devo inserire al posto di quelle stringhe del codice in blu?
    • To post as a guest, your comment is unpublished.
      Jose Goncales · 4 months ago
      Queste linee blu indicano "text ", è probabilmente una formattazione dell'editor utilizzato per creare il códice.
  • To post as a guest, your comment is unpublished.
    Mohammad · 6 months ago
    Thanks dears,, Could you please tell me how to do this but without asking for range (predefined range)?
    • To post as a guest, your comment is unpublished.
      Carter · 5 months ago
      Did anyone ever reply to you?
      • To post as a guest, your comment is unpublished.
        Jay · 4 months ago
        Set xRg = Range("A1:J10")

        Just set xRg to whatever range you want/need it to be.
  • To post as a guest, your comment is unpublished.
    greg horton · 6 months ago
    This is awesome, I love it! Quick question. I see that it is adding a border to the image. Is there a way to generate without a border? Thanks in advance!
    • To post as a guest, your comment is unpublished.
      Ian Wildman · 6 months ago
      I'd love to know how to paste without generating a border as well. This code is awesome, super intuitive and straightforward. Thank you!
  • To post as a guest, your comment is unpublished.
    Piotrek · 1 years ago
    wyrzuca mi błąd w linijce "Set xOutMail = xOutApp.CreateItem(olMailItem)" olMailItem - nie zdefiniowana
    oraz ".Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue" olByValue - nie zdefiniowana