MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Need Help for Macro to Perform Same Function Only on Certain Sheets

  Asked By: Vid    Date: Oct 10    Category: MS Office    Views: 847

I'm new to VBA and have pretty limited experience with it, and need
some help.

I've created a macro that creates a rectangle on a given sheet. That's
the easy part. What's tricky is that I need that rectangle on several
different worksheets, for simplicity let's say sheets 1-4,7,9-10 of 10.
How do I put the rectangle across certain sheets in the workbook? I can
put the rectangle on ALL the sheets, but not just specific ones.



2 Answers Found

Answer #1    Answered By: Iris Sanders     Answered On: Oct 10

Each sheet  has a unique name (user-assigned, if the defaults are
changed), and also a unique number. See the Excel VBA object model for
how to handle unique numbers. I am going to demonstrate this for unique
names only.

You can tackle this as follows:
Sub Rectangle_Sheets()

' This procedure calls the rectangle_make macro  for user-defined sheets
in this workbook.

Dim i As Integer

For i = 1 To 4
Sheets("Sheet" & i).Select
Call rectangle_make
Next i

Call rectangle_make

For i = 9 To 10
Sheets("Sheet" & i).Select
Call rectangle_make
Next i

End Sub

Answer #2    Answered By: Olga Allen     Answered On: Oct 10

The solution is good. But calling the rectangle_make program for each sheet
will be cumbersome.
I have provided a simplified version below:

Sub Rectangle_Sheets()

' This procedure calls the rectangle_make macro  with teh sheet  Number as the

' Define an array with the sheet numbers that you want the rectangle in
RecSh = Array(1, 2, 3, 4, 7, 9, 10)
' Loop thru the array and call the "rectangle_make" macro for each sheet
' You don't need to select the sheet
For i = 1 To UBound(RecSh)
Call rectangle_make(RecSh(i))
Next i

End Sub
' This macro is called by the main program
Sub rectangle_make(ShNo)

Set myDocument = Worksheets(ShNo)
' Add a rectangle at 150, 50 of size 300x200
myDocument.Shapes.AddShape msoShapeRectangle, 150, 50, 300, 200

End Sub