View Single Post
 
Old 08-16-2013, 04:36 PM
tsadamson tsadamson is offline Windows 7 64bit Office 2010 32bit
Novice
 
Join Date: Aug 2013
Posts: 1
tsadamson is on a distinguished road
Default 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
Reply With Quote