Excel에서 메시지 본문에 셀 범위를 이미지로 붙여넣으려면 어떻게 해야 하나요?

Excel에서 이메일을 보낼 때 셀 범위를 복사하여 메시지 본문에 이미지로 붙여넣어야 하는 경우, 이 작업을 어떻게 처리할 수 있을까요?

Excel에서 VBA 코드를 사용하여 셀 범위를 이메일 본문에 이미지로 붙여넣기

Excel에서 VBA 코드를 사용하여 셀 범위를 이메일 본문에 이미지로 붙여넣기

이 작업을 해결하기 위한 다른 좋은 방법은 없을 수 있지만, 이 문서의 VBA 코드가 도움이 될 수 있습니다. 아래 단계를 따르세요:

1. 복사하고 이미지로 붙여넣을 셀 범위가 있는 시트를 활성화한 후, ALT + F11 키를 눌러 Microsoft Visual Basic for Applications 창을 엽니다.

2. 삽입 > 모듈을 클릭하고, 모듈 창에 다음 코드를 붙여넣습니다.

VBA 코드: 셀 범위를 이메일 본문에 이미지로 붙여넣기:

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

참고: 위의 코드에서 본문 내용과 이메일 주소를 필요에 따라 변경할 수 있습니다.

3. 코드를 삽입한 후, F5 키를 눌러 코드를 실행합니다. 선택한 데이터 범위를 이미지로 이메일 본문에 삽입하라는 대화 상자가 나타납니다. 스크린샷을 참조하세요:

4. 그런 다음 확인 버튼을 클릭하면 메시지 창이 표시되며, 선택한 데이터 범위가 이미지로 본문에 삽입됩니다. 스크린샷을 참조하세요:

참고: 메시지 창에서 필요에 따라 본문 내용과 받는 사람 및 참조 필드의 이메일 주소를 변경할 수도 있습니다.

5. 마지막으로, 보내기 버튼을 클릭하여 이메일을 보냅니다.

참고: 여러 워크시트에서 여러 범위를 붙여넣어야 하는 경우, 아래 VBA 코드가 도움이 될 수 있습니다:

먼저, 이미지로 이메일 본문에 삽입하려는 여러 범위를 선택한 후, 다음 코드를 적용합니다:

VBA 코드: 여러 셀 범위를 이메일 본문에 이미지로 붙여넣기:

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