you can do it quite easily in code
I use something like this (which links to a custom property with the objects
IP address in it)
al
' first add a hyperlink section
If visShape.SectionExists(visSectionHyperlink, False) = False Then
visShape.AddSection visSectionHyperlink
End If
DoEvents
' now add the basic hyperlink row
blnPropAdded = funcAddHyperLinkToShape(visShape, "CallTelnet")
DoEvents
' normally we would just do this with the above call, but we want to
add
' the name of another cell with the formula so we'll do it here
If visShape.CellExists("hyperlink.calltelnet.address", False) Then
Set shpCell = visShape.Cells("hyperlink.calltelnet.address")
shpCell.FormulaU = """TELNET:""&Prop.Ipaddress"
Set shpCell = visShape.Cells("hyperlink.calltelnet.description")
shpCell.FormulaU = """TELNET:""&Prop.Ipaddress"
End If
Public Function funcAddHyperLinkToShape(visShape As Visio.Shape, _
strLocalRowName As String, _
Optional strRowNameU As String, _
Optional strDescription As String, _
Optional strAddress As String, _
Optional strSubAddress As String, _
Optional strFrame As String, _
Optional blnNewWin As Boolean, _
Optional blnDefault As Boolean) As Boolean
Dim vsoCell As Visio.Cell
Dim intRowIndex As Integer
Dim strCurrentTask As String
On Error GoTo AddHyperLink_Err
intRowIndex = visShape.AddNamedRow(visSectionHyperlink, _
strLocalRowName, VisRowIndices.visRow1stHyperlink)
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkDescription)
modMainRoutines.subSetCellValueToString vsoCell, strDescription
If (strLocalRowName <> strRowNameU And _
Len(strRowNameU) > 0) Then
vsoCell.RowNameU = strRowNameU
End If
' Column 2: Address
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkAddress)
modMainRoutines.subSetCellValueToString vsoCell, strAddress
' Column 3: SubAddress
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkSubAddress)
modMainRoutines.subSetCellValueToString vsoCell, strSubAddress
' Column 4: frame
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkExtraInfo)
modMainRoutines.subSetCellValueToString vsoCell, strFrame
' Column 5: new window
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkNewWin)
modMainRoutines.subSetCellValueToString vsoCell, CStr(blnNewWin)
' Column 6: default
Set vsoCell = visShape.CellsSRC(visSectionHyperlink, _
visRow1stHyperlink + intRowIndex, visHLinkDefault)
modMainRoutines.subSetCellValueToString vsoCell, CStr(blnDefault)
funcAddHyperLinkToShape = True
Exit Function
AddHyperLink_Err:
If Err <> 0 Then
Debug.Print "Err in func Add HyperLink To Shape " & Err & " " &
Err.Description & " " & strCurrentTask
funcAddHyperLinkToShape = False
End If
End Function
