Add Hyperlinks with VBA

Started by Jumpy, November 16, 2009, 03:36:43 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Jumpy

Hello,
I'm trying to Add a Hyperlink to a Shape with VBA:

shp.AddRow visSectionHyperlink, visRowLast, visTagDefault

This works so far, but I just added a "empty" Hyperlink row, and now I want to fill it with:

Text = "Page-2"
shp.CellsSRC(visSectionHyperlink, 0, visHLinkSubAddress).FormulaForceU = Text
shp.CellsSRC(visSectionHyperlink, 0, visHLinkDescription).FormulaForceU = Text


and I get an Runtime Error:
'-2032466907 (86db0425)'
#NAME?

What is wrong in my Code?

aledlund



I suspect you've been burned by the "not enough quote marks". I call a function kinda like this



                AddHyperLinkToShape visShape, "CallTelnet"
                ' after it has been created add the address and other info to it
                If visShape.CellExists("hyperlink.calltelnet.address", False) = true Then
                    Set visCell = visShape.Cells("hyperlink.calltelnet.address")
                    visCell.FormulaU = """TELNET:""&Prop.compIpAddress"
                    Set visCell = visShape.Cells("hyperlink.calltelnet.description")
                    visCell.FormulaU = """TELNET:""&Prop.compIpAddress"
                'End If


    '*********************************************************************
    '*********************************************************************
    '
    '               Hyperlink
    '
    '*********************************************************************
    '*********************************************************************
    Public Function AddHyperLinkToShape _
                (ByVal visShape As Visio.Shape, _
                ByVal strLocalRowName As String, _
                Optional ByVal strRowNameU As String = "", _
                Optional ByVal strDescription As String = "", _
                Optional ByVal strAddress As String = "", _
                Optional ByVal strSubAddress As String = "", _
                Optional ByVal strFrame As String = "", _
                Optional ByVal blnNewWin As Boolean = False, _
                Optional ByVal blnDefault As Boolean = False) _
                As Boolean

        Dim vsoCell As Visio.Cell
        Dim intRowIndex As Integer

        ' I like to test here so that we know that one is there and don't add
        ' another by mistake
        If visShape.SectionExists(visSectionHyperlink, False) = False Then
            visShape.AddSection (visSectionHyperlink)
        End If

       
        On Error GoTo AddHyperLinkToShape_err
       
            intRowIndex = visShape.AddNamedRow(visSectionHyperlink, _
                 strLocalRowName, _
                 Visio.VisRowIndices.visRow1stHyperlink)

            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkDescription)
            SetCellValueToString vsoCell, strDescription

            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.rowNameU = strRowNameU
            End If

            ' Column 2: Address
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkAddress)
            SetCellValueToString vsoCell, strAddress

            ' Column 3: SubAddress
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkSubAddress)
            SetCellValueToString vsoCell, strSubAddress

            ' Column 4: frame
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkExtraInfo)
            SetCellValueToString vsoCell, strFrame

            ' Column 5: new window
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkNewWin)
            SetCellValueToString vsoCell, CStr(blnNewWin)

            ' Column 6: default
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkDefault)
            SetCellValueToString vsoCell, CStr(blnDefault)

            AddHyperLinkToShape = True
            Exit Function
           
AddHyperLinkToShape_err:

        AddHyperLinkToShape = False

    End Function


Paul Herber

Easier to use shp.Hyperlinks.Add.Address = Text

Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/