Creating shapes on spreadsheet on the fly

Waimea

Active Member
Joined
Jun 30, 2018
Messages
465
Office Version
  1. 365
Platform
  1. Windows
I am trying to create a menu with shapes that create itself on every page and fills in sheet names as shape text boxes.

I want to loop through an array of sheet names and an array of macro names and assign a macro for each shape textbox.

Code:
Dim sheetNames As Variant
Dim macroNames() As Variant
sheetNames = Array("Sheet1", "Sheet2", "Sheet3")
macroNames2 = Array("Macro1","Macro2","Macro3")

I have code to create the rectangle that defines the menu.

Code:
 Dim menyShp As Shape
 Dim menyHeaderShp As Shape
    
    Set menyShp = Sheet2.Shapes.AddShape(msoShapeRectangle, 193, 55, 864, 260)
    With menyShp
      .Fill.ForeColor.RGB = RGB(255, 255, 255)
      .Line.ForeColor.RGB = RGB(255, 255, 255)
      .Name = "menyShape"
      '.OnAction = ""
    End With


    Set menyHeaderShp = Sheet2.Shapes.AddShape(msoShapeRectangle, 195, 108, 303, 50)
    With menyHeaderShp
      .Fill.ForeColor.RGB = RGB(255, 255, 255)
      .Line.ForeColor.RGB = RGB(255, 255, 255)
      .Name = "menyHeaderShp"
      .OnAction = "test2"
    End With

I would like to check if the menyShp exists and if yes then exit sub.

I am stuck on how to loop through the two arrays and using the on action property of the shape to assign the macro to the correct shape?

Code to add another shape with sheet name in it:

Code:
 ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 463.5, 139.5, 160, 26.5).Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Sheet1"
End Sub

To offset the shapes so that they automatically get in the correct column. I want to have 3 or 4 columns with 5 or 6 sheet names in each.

Code:
Worksheet.Shapes.AddShape(AutoShapeType, Left, Top, Width, Height)

I think that I need to offset the left and top properties!

All suggestions on how to proceed are welcome!
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Code:
Sub test()

Dim i As Integer
Dim x As Integer
Dim y As Integer


y = 2
x = 2
For i = 1 To 10


       If i > 5 Then
       x = 4
       y = 4
       
        ElseIf i >= 5 Then
        x = 4
        y = 4
        End If
         
       ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, x & i, y & i, 144.5, 25.5).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(251, 99, 126)
        .Transparency = 0
        .Solid
    End With
        Next i
        
End Sub

This kind of works but I still need to loop though the array with the sheetnames and with the macros.
 
Upvote 0
Code:
Dim i As Integer
Dim x As Integer
Dim y As Integer


x = 100
y = 144


For i = 1 To 21


       If i = 8 Then
       x = 250
       y = 144
       
        ElseIf i = 15 Then
        x = 400
        y = 144
        End If
              
       ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100 + x, y, 144.5, 25.5).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(251, 99, 126)
        .Transparency = 0
        .Solid
    End With
    
    y = y + 30
        Next i
        
End Sub

Now it works and I get 3 columns with 7 items in each column.

I want to name each shape with the name from the array and I want to assign a macro to each shape!

How can I loop through the two arrays?

Code:
Dim sheetNames As Variant
Dim macroNames() As Variant
sheetNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10")
macroNames2 = Array("Macro1","Macro2","Macro3")
 
Upvote 0
What is a good way of checking if a shape/shapes exist and if yes, do nothing, if no, create it?
 
Upvote 0
I have my meny that is created on the fly, I am using a public variable to keep track of if the shape exists or not.

I want to check if the shape exists, if yes, do nothing, if no, create the shape.

Any suggestions?
 
Last edited:
Upvote 0
I am still working on this!

It would be very kind if someone could help me?
 
Upvote 0
I have helped you on numerous other questions but this one I have monitored since you posted it and am sorry to see no one has a answer for you. I do not have a answer.

I get lost on your first line of the question where you said:

I am trying to create a
menu
with shapes that create itself on every page and fills in sheet names as shape text boxes.

What do you define as a Menu?

I always like to ask users what is your ultimate Goal and are you willing to do things another way.

But some users are already set on how they want to do things.

It sort of looks like you want users to be able to run Macros from what you call a Menu. By clicking on the Macro name in a shape. I did some work for a user similar to this several Months ago but the user ran the script from choosing a Macro name from a Combobox. Not sure if you were that person.

I have written scripts before where users select a macro name from a Userform Listbox. This Userform could be displayed and your still able to work on the sheet with the userform visible. Click on a macro name in the userform listbox and that macro would run.

But not sure if that would work for you.

I have no ideal how to do things the way you seem to want to do things.

But maybe someone here at Mr. Excel will be able to help you.

I will continue to monitor this thread
 
Upvote 0

Forum statistics

Threads
1,215,432
Messages
6,124,859
Members
449,194
Latest member
HellScout

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top