title: Copy Excel range as Picture to Outlook
body: <p>How can I use the command "Paste Special - As Picture" that you access in Excel from the right-click menu?</p>
  
  <p>I have viewed various posts, but they seem to be outdated when using Excel 2016. It seems it has to be in this section, </p>
  
  <pre><code>With TempWB.Sheets(1)
      .Cells(1).PasteSpecial Paste:=8
      .Cells(1).PasteSpecial xlPasteValues, , False, False
      .Cells(1).PasteSpecial xlPasteFormats, , False, False
      .Cells(1).Select
  </code></pre>
  
  <p>How do I alter to allow copy and paste as picture?</p>
  
  <p>When using the original code below, I lose all column and row sizing in the email body.</p>
  
  <pre><code>Dim rng As Range
  Dim OutApp As Object
  Dim outMail As Object
  
  Set rng = Nothing
  ' Only send the visible cells in the selection.
  
  Set rng = Sheets("Dashboard").Range("B4:L17").SpecialCells(xlCellTypeVisible)
  
  With Application
      .EnableEvents = False
      .ScreenUpdating = False
  End With
  
  Set OutApp = CreateObject("Outlook.Application")
  Set outMail = OutApp.CreateItem(0)
  
  With outMail
      .To = ""
      .CC = ""
      .BCC = ""
      .Subject = ""
      .HTMLBody = RangetoHTML(rng)
      .Display
  End With
  On Error GoTo 0
  
  With Application
      .EnableEvents = True
      .ScreenUpdating = True
  End With
  
  Set outMail = Nothing
  Set OutApp = Nothing
  End Sub
  
  
  Function RangetoHTML(rng As Range)
  ' By Ron de Bruin.
      Dim fso As Object
      Dim ts As Object
      Dim TempFile As String
      Dim TempWB As Workbook
  
      TempFile = Environ$("temp") &amp; "/" &amp; Format(Now, "dd-mm-yy h-mm-ss") &amp; ".htm"
  
      'Copy the range and create a new workbook to past the data in
      rng.Copy
      Set TempWB = Workbooks.Add(1)
      With TempWB.Sheets(1)
          .Cells(1).PasteSpecial Paste:=8
          .Cells(1).PasteSpecial xlPasteValues, , False, False
          .Cells(1).PasteSpecial xlPasteFormats, , False, False
          .Cells(1).Select
          Application.CutCopyMode = False
          On Error Resume Next
          .DrawingObjects.Visible = True
          .DrawingObjects.Delete
          On Error GoTo 0
      End With
  
      'Publish the sheet to a htm file
      With TempWB.PublishObjects.Add( _
           SourceType:=xlSourceRange, _
           Filename:=TempFile, _
           Sheet:=TempWB.Sheets(1).Name, _
           Source:=TempWB.Sheets(1).UsedRange.Address, _
           HtmlType:=xlHtmlStatic)
          .Publish (True)
      End With
  
      'Read all data from the htm file into RangetoHTML
      Set fso = CreateObject("Scripting.FileSystemObject")
      Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
      RangetoHTML = ts.ReadAll
      ts.Close
      RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                            "align=left x:publishsource=")
  
      'Close TempWB
      TempWB.Close savechanges:=False
  
      'Delete the htm file we used in this function
      Kill TempFile
  
      Set ts = Nothing
      Set fso = Nothing
      Set TempWB = Nothing
  End Function
  </code></pre>