Shape Link to Sheets

Question

I like this idea by rich007a. Can't seem to get it to work properly though. 

My original post was (http://answers.microsoft.com/en-us/office/forum/office_2007-customize/hyperlink-image-move-to-top-of-page/7400c0bd-831f-48bd-994a-2e43f3ac21fa) With no luck, by trying to use Images to link to the a particular cell and being it to the top of the window.

Sub AllBtnClick()

    Dim rng As Range

    Select Case ActiveSheet.Shapes(Application.Caller).AlternativeText

        Case "Text on btn1": Set rng = Worksheets("Sheet1").Range("A110:B111")

        Case "Text on btn2": Set rng = Worksheets("Sheet2").Range("C110:D111")

        Case "Text on btn3": Set rng = myNamedRange

        Case Else ' do nothing

    End Select

    Application.Goto rng, scroll:=True

End Sub

Here is what I am doing.

1. I add the Shape I want to a Sheet - Write in the Text I want (Monday)
2. Change Text on btn1 to Monday -Sheet1to Creator (name of the sheet I am using) - A110:B111 to A9:A10.
3. The code above is put into the View Code for that particular sheet.

Any assistance would be great.

-----------------------------------------------------------------------------------------Edit

SOLUTION TO MY QUESTION:

Here is the code that I needed for linking Shapes to cells to work.

---

So everyone knows how to use the code...

1. Insert the desired shape..
2. Write in what you want in the Shape. (in this example, Monday)
3. Right-Click and select Size and Properties -****Select Alt Text
4. Write in the same Text as you put in the Shape (Monday)
5. Right-Click on the Sheet you have the shape in and click - View Code
6. Past this in the blank area in Microsoft Visual Basic

Sub AllBtnClick()

Dim rng As Range

Select Case ActiveSheet.Shapes(Application.Caller).AlternativeText

Case "Monday": Set rng = Range("A9:A10")

Case Else ' do nothing

End Select

Application.Goto rng, scroll:=True

End Sub

Save and close.

This should allow you to Click on the desired cell and link it to any particular cell Range in your Sheet.

---- Note

If you want it to link to another sheet.. Use this code.

Sub AllBtnClick()

Dim rng As Range

Select Case ActiveSheet.Shapes(Application.Caller).AlternativeText

Case "Monday": Set rng = **Worksheets("Sheet2").**Range("A9:A10")

Case Else ' do nothing

End Select

Application.Goto rng, scroll:=True

End Sub

The only thing different is "Worksheets("Creator")." which is added infront of "Range."

Answer 1

If you select the shape and display the Size & properties dialog you should see the Alt Text options. This is the text used on web pages.

It could be that what you really need to check in you code is the Text, as you are actually altering the display text rather than the alternative text.

Select Case ActiveSheet.Shapes(Application.Caller).textframe.characters.text

The sheet and book names are ther because the code in stored in a sheet object rather than a standard code module.

Simply cut and paste the routine from the sheet object to a standard code module.

You will need to reassign the macro to the shapes.

Answer 2

Double check the Alternative text is what you need it to be for each shape.

Then add this test to make sure you have a valid location to scroll to.

    If Not rng Is Nothing Then Application.Goto rng, scroll:=True

Answer 3

Alrighty. Assigned the Shape with AllBtnClick, but gave an Invalid procedure or argument once clicked. 

This is the code I ended up with once all the shapes were in place at the top of a Frozen Range of cells on Creator Sheet.

Sub AllBtnClick()

Dim rng As Range

Select Case ActiveSheet.Shapes(Application.Caller).AlternativeText

Case "Monday": Set rng = Worksheets("Creator").Range("A9:A10")

Case "Tuesday": Set rng = Worksheets("Creator").Range("A35:B36")

Case "Wednesday": Set rng = Worksheets("Creator").Range("A61:B62")

Case "Thursday": Set rng = Worksheets("Creator").Range("A87:B88")

Case "Friday": Set rng = Worksheets("Creator").Range("A112:B113")

Case "Saturday": Set rng = Worksheets("Creator").Range("A139:B140")

Case "Sunday": Set rng = Worksheets("Creator").Range("A1165:B166")

Case Else ' do nothing

End Select

Application.Goto rng, scroll:=True

End Sub

I guess, from step by step, how should I implement this code?

Thanks!

Answer 4

Where is myNamedRange Set?

Answer 5

Did you assign the macro, AllBtnClick, to the shape(s) ?