Changing the sizing when pasting image to Outlook via macro

[mikeellinas]

Hi. I have a Module that copies and pastes into a new outlook email:

Sub Email()

'Copy range of interest
Dim r As Range
Set r = Range("A1:E24")
r.Copy
'Open a new mail item
Dim outlookApp As Outlook.Application
Set outlookApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.MailItem
Set outMail = outlookApp.CreateItem(olMailItem)
With outMail
.CC = "xxxxxx"
.Subject = "xxxxxxxx"
End With

'Get its Word editor
outMail.Display
Dim wordDoc As Word.Document
Set wordDoc = outMail.GetInspector.WordEditor
'To paste as picture
wordDoc.Range.PasteAndFormat wdChartPicture
End Sub

This works great for me with one exception. The image is small and blurry in the outlook window. When I manually re-size it larger in the outlook window before sending, it looks great. After re-sizing, I clicked on image properties and in the Layout/Size tab, it says Height is absolute 5.84"; Width is Absolute 12.27"; Scale Height and Width are both 80% with "lock aspect ratio" and "relative to original picture size" boxes both checked. The original size says 7.29" and original width says 15.28".

Can someone help me program the resizing to happen automatically as part of my module?

 

[Kenneth Hobson]

wordDoc.Range.PasteAndFormat wdChartPicture
    With wordDoc.InlineShapes(1)
      .LockAspectRatio = msoFalse
      .Height = 7.29 * 72
      .Width = 15.28 * 72
    End With

 

[mikeellinas]

This worked!!!! A thousand thank you's! I used that but did *50 as the 72 was a bit too big

 

[mikeellinas]

Something else I did not notice until just now. When running this, I just realized it erases my email signature. Is there a way to preserve the email signature? Or should I post this as a separate question in a new post?

 

[Kenneth Hobson]

Depends on how you are getting your signature I guess. I get mine from a RTF file. Putting it at the end, introductory text at the beginning, and a copied range in the middle can be a challenge. I even threw in an OLEObject one time. That gets real tricky to get the right order. I can make a simple example. What is the order of the copied range, first/beginnging or middle, or?

The 72 is for the conversion from inches to points as you can see for one inch to points.

 MsgBox Application.InchesToPoints(1)

TIP: Paste code between code tags to sort of maintain structure. Click the # icon on toolbar to insert the tags.

 

[Kenneth Hobson]

Obviously, change the path to sig to yours. The first rtf file can be determined but may not be the sig that you want. Change Subject, intro and ending body Text to suit. Change the dimensions to suit as well. You may need to adjust the String() value depending on the size of the oleobject/shape and body/Range's font size.

Sub Email()
  'Copy range of interest
  Dim r As Range, sig$
  'Tools > References > Microsoft Outlook xx.0 Object Library > OK
  Dim outlookApp As Outlook.Application, outMail As Outlook.MailItem
  'Tools > References > Microsoft Word xx.0 Object Library > OK
  Dim wordDoc As Word.Document, wr As Word.Range
  
  sig = "C:\Users\lenovo1\AppData\Roaming\Microsoft\Signatures\std.rtf"
  Set r = Range("A1:E24")
  
  Set outlookApp = CreateObject("Outlook.Application")
  'Open a new mail item
  Set outMail = outlookApp.CreateItem(olMailItem)
  With outMail
    .To = "ken@gmail.com"
    '.CC = "xxxxxx"
    .Subject = "Range A1:E24 Pic"
    
    'Get its Word editor
    Set wordDoc = .GetInspector.WordEditor
    '.Content = "Dear Sir:" & vbCrLf & vbCrLf & _
      "Your range A1:E24 is:" & vbCrLf & vbCrLf
    Set wr = wordDoc.Range
  End With
    
  With wr
    .Font.Name = "Arial"
    .Font.Size = 16
    
    .Text = "Dear Sir:" & vbCrLf & vbCrLf & _
      "Your range A1:E24 is:" & vbCrLf & vbCrLf
    .Collapse Direction:=wdCollapseEnd
    
    'To copy/paste as picture
    r.Copy
     '.PasteAndFormat wdChartPicture
    .PasteSpecial wdInLine, , , , wdPasteOLEObject  'Anchors inline...
    With .ShapeRange(1)
      .LockAspectRatio = msoFalse
      .Height = 6 * 72
      .Width = 8 * 72
    End With
    
    'Add enough lines to get to end of oleobject.
    .InsertAfter String(25, vbCrLf)
    .Collapse Direction:=wdCollapseEnd
   
    .Text = vbCrLf & "If you have any questions, please contact me." & _
      String(2, vbCrLf)
    .Collapse Direction:=wdCollapseEnd
    
    .InsertFile sig, , , False, False
  End With
      
    outMail.Display
    'outmail.Send
End Sub

 

[mikeellinas]

Depends on how you are getting your signature I guess. I get mine from a RTF file. Putting it at the end, introductory text at the beginning, and a copied range in the middle can be a challenge. I even threw in an OLEObject one time. That gets real tricky to get the right order. I can make a simple example. What is the order of the copied range, first/beginnging or middle, or?

The 72 is for the conversion from inches to points as you can see for one inch to points.

 MsgBox Application.InchesToPoints(1)

TIP: Paste code between code tags to sort of maintain structure. Click the # icon on toolbar to insert the tags.

I see. Thanks for explaining!