Set InlineShapes Properties
Hi,
From Word (Office 2010, Word Version 14) I am copying a range from Excel and pasting it as a picture into word and I need to change the ScaleHeight, ScaleWidth and then Center the picture on the page. Eventually I will be coping about 20 or so ranges from Excel and pasting them as pictures into word so I will need to do this for each picture because each Excel range is a different size and I need to make sure they will fit on one page.
'Copies data from Excel
Set eBal = Range("Bal")
eBal.Copy
'Pastes data to word as a picture
ActiveDocument.Bookmarks("Bal").Range.PasteSpecial , , wdInLine, , DataType:=wdPasteEnhancedMetafile
'Finds the last picture I pasted and changes it.
i = ActiveDocument.InlineShapes.Count
ActiveDocument.InlineShapes(i).ScaleHeight = 50
ActiveDocument.InlineShapes(i).ScaleWidth = 50
ActiveDocument.InlineShapes(i).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
I don't like the last section where I have to count the current shapes and then use that to set the shapes properties. I wish I could just format the picture as it is pasted or without having to use ActiveDocument.InlineShapes(i)
Below is my entire code which works, but I am just concerned it will break. I will be adding a lot more paste ranges once I get this working with each paste range having a different ScaleHeight and Scalewidth.
Sub CopyRanges()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim eIncome As Excel.Range
Dim eBal As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim BoardExcel As String
Dim i As Integer
BoardExcel = "C:\Users\tsadamson\Desktop\testing\ExcelTest.xlsx "
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
' Application.ScreenUpdating = False
' Application.EnableEvents = False
' Application.DisplayAlerts = False
oXL.Visible = True
Set oWB = oXL.Workbooks.Open(FileName:=BoardExcel)
Set eIncome = Range("Income")
Set eBal = Range("Bal")
'Copy Income Statement and paste as picture
eIncome.Copy
ActiveDocument.Bookmarks("Income").Range.PasteSpec ial , , wdInLine, , DataType:=wdPasteEnhancedMetafile
i = ActiveDocument.InlineShapes.Count
ActiveDocument.InlineShapes(i).ScaleHeight = 150
ActiveDocument.InlineShapes(i).ScaleWidth = 150
ActiveDocument.InlineShapes(i).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Copy Balance Sheet and paste as picture
eBal.Copy
ActiveDocument.Bookmarks("Bal").Range.PasteSpecial , , wdInLine, , DataType:=wdPasteEnhancedMetafile
i = ActiveDocument.InlineShapes.Count
ActiveDocument.InlineShapes(i).ScaleHeight = 50
ActiveDocument.InlineShapes(i).ScaleWidth = 50
ActiveDocument.InlineShapes(i).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
If ExcelWasNotRunning Then
oXL.Quit
End If
Set oWB = Nothing
Set oXL = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox BoardExcel & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
' Application.ScreenUpdating = True
' Application.EnableEvents = True
' Application.DisplayAlerts = True
End Sub
Thanks for any help
tsadamson
|