Rename Autoshape and adding text

melindaking

New Member
Joined
Feb 22, 2008
Messages
13
I am trying to rename an auto shape in VBA, then add text and a hyperlink to this auto shape.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
I want to rename an auto shape with a value stored in a cell in a worksheet (eg Summary)
Then add text to the auto shape, again with the name Summary.
Then add a hyperlink to this auto shape to link to a page called summary.

If anyone can help me out it would be great
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Thanks Brian,
I am trying to use your code, but it doesn't seem to like the .Name and the text assignment.
Could you let me know what I am doing wrong?
My code is below
Many thanks
Mel

'Prepare the buttons for the menus
Sheets("MenuBoth").Range("A1").Select
Dim ShapeObj As Object
'(Across Page, Down Page, length, width)
Set ShapeObj = Sheets("MenuBoth").Shapes.AddShape(msoShapeRectangle, 10, 210, 170, 25).Fill
With ShapeObj
.ForeColor.RGB = RGB(0, 0, 97)
.BackColor.RGB = RGB(0, 0, 97)
.TwoColorGradient msoGradientHorizontal, 1
.Name = Sheetname
With .TextFrame
.Characters.Text = Sheetname
.Characters.Font.Size = 10
.Characters.Font.ColorIndex = 10
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
 
Upvote 0
A couple of errors. Copy/paste & run the code below. Amend as necessary.
1. You need to keep an eye on the heirarchy of object properties. For example you will see how I have repositioned '.Fill' in your code.
2. You are not showing an initialisation of the Sheetname variable. Your code at present will show nothing for this - with no error message.
3. You have defined ForeColor and BackColor the same - so no gradient effect. Need to set the font colour a contrasting colour too.
4. '.Name = Sheetname' will work (assuming you have defined 'Sheetname' as in 2) ... but only once.
If you want to make another shape you will need to give it another name - or get an error message.
See in my code how I have used the code for a single Trapezoid in a subroutine to achieve this. See how much easier it is to re-format the shape set as necessary.
A couple of pointers regarding messages in the forum. If we can read and understand your code it is more likely you will get an answer. The more you can help us, the more we can help you.
1. Please format your code correctly in the code module, and add comments to show what it is supposed to do.
The more advanced you get,with bigger projects, the more you will be doing this for yourself anyway. I can often go back to code I wrote months ago and change it in a couple of minutes.
2. Copy/paste the code into your message and select it and click the [#] 'Code' button above the message. If the button is not there you will need to type in the HTML tags manually. [ code] at the beginning and [ /code] (without spaces) at the end. This ensures your formatting stays intact.
2. "doesn't seem to like .. " is not a good desciption of a problem. We need to know the line number the code stops at, and the error message. What do you want to happen ? What actually happens ? You did give a good message title.
Hope all this helps - and welcome to the forum.
Code:
'=============================================================================
'-  Prepare the buttons (Rectangles) for the menus (THIS CODE ONLY DOES 1)
'=============================================================================
Sub test()
    Dim ShapeObj As Object
    Dim SheetName As String
    '-------------------------------------------------------------------------
    Sheets("MenuBoth").Range("A1").Select ' only works if the sheet is the Active one
    SheetName = "Test"
    '-------------------------------------------------------------------------
    '(Across Page, Down Page, length, width)
    Set ShapeObj = _
        Sheets("MenuBoth").Shapes.AddShape(msoShapeRectangle, 10, 210, 170, 25)
    '--------------------------------------------------------------------------
    With ShapeObj
        '----------------------------------------------------------------------
        .Fill.ForeColor.RGB = RGB(0, 0, 255)
        .Fill.BackColor.RGB = RGB(0, 0, 97)
        .Fill.TwoColorGradient msoGradientHorizontal, 1
        '---------------------------------------------------------------------
        '- NAME THE RECTANGLE
        .Name = SheetName
        '---------------------------------------------------------------------
        '- RUN A MACRO
        '  .OnAction = "Macro1"
        '---------------------------------------------------------------------
        With .TextFrame
            .Characters.Text = SheetName
            .Characters.Font.Size = 10
            .Characters.Font.ColorIndex = 2
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
        '--------------------------------------------------------------------
    End With
End Sub
'=============================================================================
 
Upvote 0
Thank you so much, that has worked a treat.
I will take your tips on board for any other queries I may have.
Thanks again
M
 
Upvote 0

Forum statistics

Threads
1,216,416
Messages
6,130,486
Members
449,584
Latest member
LeChuck

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