Hyperlink HyperTension
 

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

Hyperlink HyperTension
 

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

Hyperlink HyperTension
 

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

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

Hyperlink HyperTension
 

It is my understanding:
Modules are limited to about 64K in size. Export the module and look at
the file size for an estimate.

Tim provides sound advice.

--
Regards,
Tom Ogilvy

"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