Excel Zoom in Macro

[#1]

Hi to All,

I export some QVs table to an excel sheet and then I format the sheet.

At the end I want to zoom the sheet to 89% and then save it.

I tried with :

set XLSheet = XLDoc.Worksheets(1)

XLSheet.PageSetup.Zoom = 89

XLSheet.ActiveWindow.Zoom = 89

But both doesn't works (the second prompt an error)

Any idea ?

Further to that I want to resize an image I export to the sheet trough CopyBitmapToClipboard but no way.

Any idea ?

Thanks !

Sergio

[#2 · Accepted solution]

The correct property is ActiveWindow.Zoom, but it must be done on your Excel Object, not your Sheet. Here's a snippet of the code:

Set oXL=CreateObject("Excel.Application")
Set oWB=oXL.Workbooks.Open(f_name)
Set oSH=oWB.Worksheets.Item(1)
...
oXL.ActiveWindow.Zoom = 89
oWB.Save
oWB.Close

[#3]

Great NMiller !

It works !

Have u an idea about how to resize an image in excel from Macro ?

I've copied it trough CopyBitmapToClipboard and pasted.

Thanks

Sergio

[#4]

I'm not sure how the picture would be identified in the Object Model after being pasted.

I pasted a picture into a blank document and then recorded a macro of resizing it to 50%. Here is what I got:

oXL.ActiveSheet.Shapes("Object 1").Select
oXL.Selection.ShapeRange.LockAspectRatio = msoTrue
oXL.Selection.ShapeRange.Height = 260.25
oXL.Selection.ShapeRange.Width = 346.5

I added the oXL to each line, because I think it should work that way. The tricky part may be figuring out the name of your pasted object. If there are no other objects, it may be Object 1. You may be able to say something like:

Let img = oXL.Paste '(I'm not sure what you used for that line of code)
' and then use
img.ShapeRange.LockAspectRatio = msoTrue
img.ShapeRange.Height = 260.25
img.ShapeRange.Width = 346.5

I'm not sure if that works though.

[#5]

Ya,

It works.

For your information the name of the object is a counter.

So :

' Select the last image copied

XLApp.ActiveSheet.Shapes(XLApp.ActiveSheet.Shapes.Count).Select

' Select the first image

XLApp.ActiveSheet.Shapes(1).Select

Thanks

Sergio