Macro for multiple worksheets

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Amber - 20 Jan 2006 20:33 GMT

Any help would be appreciated. I have a workbook with several
spreadsheets that contain small picture files. Each time I open the
workbook I would like a macro to run on each worksheet and resize the
files to a specific size. The code I have so far is below. It only
resizes the images on the worksheet that is active when opening the
document. What am I missing?

Thanks!
---------------------------------------------

Sub Auto_Open()

Dim ws As Worksheet

For Each ws In Worksheets
ActiveSheet.DrawingObjects.Select
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 21#
.ShapeRange.Width = 24.75
.ShapeRange.Rotation = 0#
.Placement = xlMove
.PrintObject = True
End With
Next ws

End Sub

Reply to this Message

Gary Keramidas - 20 Jan 2006 20:34 GMT

untested, but have you tried this

ws.DrawingObjects.Select
instead of
ActiveSheet.DrawingObjects.Select

Signature

Gary

> Any help would be appreciated. I have a workbook with several
> spreadsheets that contain small picture files. Each time I open the
[quoted text clipped - 23 lines]
>
> End Sub

Reply to this Message

Amber - 20 Jan 2006 20:52 GMT

Yes, but I get a runtime error on line .ShapeRange.LockAspectRatio =
msoTrue
Any other ideas?
Thanks!
Amber

Reply to this Message

Gary Keramidas - 20 Jan 2006 20:51 GMT

no, didn't test the actual code. becasue i thought you mentioned it worked

this did work for me

Option Explicit
Sub r()
Dim ws As Worksheet

For Each ws In Worksheets

With ws.DrawingObjects
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 21#
.ShapeRange.Width = 24.75
.ShapeRange.Rotation = 0#
.Placement = xlMove
.PrintObject = True
End With
Next ws

End Sub

Signature

Gary

> Yes, but I get a runtime error on line .ShapeRange.LockAspectRatio =
> msoTrue
> Any other ideas?
> Thanks!
> Amber

Reply to this Message