Hyperlink HyperTension
You don't need to write a sub for each shape.
Use a single sub and within that use "Application.Caller" - this will
return the name of the shape which was clicked.
Sub Rectangle_Click()
dim sName as string, rng as range
sName = Application.Caller
select case sName
case "Shape1":Set rng = ActiveSheet.Range("F2")
'....other cases
case "ShapeX":Set rng = ActiveSheet.Range("F200")
end select
Application.Goto rng, True
ActiveWindow.ScrollRow = rng.Row
ActiveWindow.ScrollColumn = rng.Column
End Sub
Tim.
"SubSeaGuy" wrote in message
...
Tom,
Thanks.. I always seem to get caught up in solving a problem and
forget
sometimes it's just best to do some things manually. I have about
50 of
these links and seem to have run up against a wall for the number of
subs or
lines you can have in a module. Is there a limit or is it something
else?
SubSeaGuy
"Tom Ogilvy" wrote:
Don't use a hyperlink. Just assign a macro to the rectangle:
Sub Rectangle_Click()
Set rng = ActiveSheet.Range("F2")
Application.Goto rng, True
ActiveWindow.ScrollRow = rng.Row
ActiveWindow.ScrollColumn = rng.Column
End Sub
--
Regards,
Tom Ogilvy
"SubSeaGuy" wrote in message
...
I have attached a hyperlink to a text box which links to a cell
within the
same worksheet. There are many occurences of this in the
worksheet where
cells point to other cells so the same hyperlink won't work for
all text
boxs'. Therefore a single macro will not work. The hyperlink
will get to
the appropriate cell, and it becomes active. In the same
hyperlink
execution, I want the active cell to be placed at the top left of
the
screen.
I have no trouble doing this with a cell hyperlink using the
FollowHyperlink
(courtsey of Bill Manville) event but it does not seem to work
with a text
box. Can anyone help?
Private Sub Workbook_SheetFollowHyperlink(ByVal Target As
Hyperlink)
Dim iChar As Integer
Dim stAddr As String
stAddr = Target.SubAddress
MsgBox (stAddr)
iChar = InStr(stAddr, "!") ' Sheet!Range ?
If iChar 0 Then
ShtName = Left(stAddr, iChar - 1)
stAddr = Mid(stAddr, iChar + 1)
End If
With ActiveWindow.Panes(ActiveWindow.Panes.Count)
.ScrollRow = Range(stAddr).Row
.ScrollColumn = Range(stAddr).Column
End With
End Sub
|