ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro for multiple worksheets (https://www.excelbanter.com/excel-programming/351055-macro-multiple-worksheets.html)

Amber[_3_]

Macro for multiple worksheets
 
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


Gary Keramidas

Macro for multiple worksheets
 
untested, but have you tried this

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



--


Gary


"Amber" wrote in message
oups.com...
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




Gary Keramidas

Macro for multiple worksheets
 
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

--


Gary


"Amber" wrote in message
ups.com...
Yes, but I get a runtime error on line .ShapeRange.LockAspectRatio =
msoTrue
Any other ideas?
Thanks!
Amber




Amber[_3_]

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



All times are GMT +1. The time now is 11:15 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com