创建 excel vba 超链接的语句引发运行时“1004”错误

Question

所以我有几个关于 excel VBA 的问题，我很感谢大家在我偶然了解这一切的过程中对我的包容。您的回答是一个巨大的帮助和学习经验。

到目前为止，我有一个子例程，其主要职责是编写通过具有各种验证和动态组合框的用户表单收集的所有值。我的最后一个任务是让这个子例程为之前循环选择的位置分配一个超链接。但是使用我当前的语法，我得到一个“对象'范围'的运行时错误'1004'方法'_default'失败”。一些研究证明，为了避免此错误，单元格坐标后面需要一个 .address 属性，但它并没有解决问题。代码如下：

    Option Explicit
    Dim cnt As Integer
    Dim i As Long, rowOff As Long
    Dim dateSel As String
    Dim timeSel As String
    Dim branch As String
    Dim sht As Worksheet
    Dim cel As Range
    Dim matchingHeader As Range

    Public Sub UserForm_Initialize()
        'clear form
        BranchBox.Value = ""
        DateBox.Value = ""
        TimeBox.Value = ""

        'populate sheet names from each branch
        For Each sht In ActiveWorkbook.Sheets
          If sht.Name = "ApplicantInfo" Then
            'Do Nothing
          Else
            Me.BranchBox.AddItem sht.Name
          End If
        Next sht
    End Sub

    Public Sub HoldButton_Click() 'revisit... throwing Time message box regardless what's selected
        If TimeBox.Value <> "" Then
            If DateBox.Value <> "" Then
                If BranchBox.Value <> "" Then
                    sht.Cells(rowOff, i).Value = "-"
                    'Save workbook
                Else
                    MsgBox "You must select a branch for your appointment"
                End If
            Else
                MsgBox "You must select a date for your appointment"
            End If
        Else
            MsgBox "You must select a time for your appointment"
        End If
    End Sub

    Private Sub ResetButton_Click()
        FirstName.Value = ""
        LastName.Value = ""
        EMail.Value = ""
        Phone.Value = ""
        Skills.Value = ""
        'BranchBox.Value = "" throws error
        DateBox.Value = ""
        TimeBox.Value = ""
    End Sub

    Private Sub ScheduleButton_Click()
        Dim row As Long, column As Long
        Dim linkDisplay As String
        'test for RowOff and i <> 0
        If IsNull(BranchBox) = True Then
            MsgBox "Select a branch for you interview before you click schedule"
        Else
            If IsNull(DateBox) = True Then
                MsgBox "Select a date for you interview before you click schedule"
            Else
                If IsNull(TimeBox) = True Then
                    MsgBox "Select a time for you interview before you click schedule"
                Else
                    'find first empty row in applicant profile tab.
                    'Insert applicant information in free row
                    'parse applicant name as a link to found free row above
                    'replace "-" placeholder for held appointment with applicant name as a link

                    Call GetFirstEmptyRow
                    'write selected values into row
                    Dim InfoRow As Integer
                    InfoRow = ActiveCell.row
                    ActiveCell.Value = ActiveCell.Offset(-5, 0).Value + 5
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = LastName.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = FirstName.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = EMail.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = Phone.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = Skills.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = BranchBox.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = DateBox.Value
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = TimeBox.Value

                    branch = BranchBox.Value
                    Set sht = ActiveWorkbook.Worksheets(branch)
                    dateSel = DateBox.Value
                    timeSel = TimeBox.Value

                    'scan for selected date
                    For i = 2 To sht.Rows.Count
                        Set cel = sht.Cells(i, 1)
                        If cel.Value = dateSel Then
                            column = i
                            Exit For
                        End If
                    Next i

                    'Scan for selected time
                    For i = 2 To sht.Columns.Count
                        Set cel = sht.Cells(1, i)
                        If CStr(cel.Value) = timeSel Then
                            row = i
                            Exit For
                        End If
                    Next i

                    linkDisplay = LastName.Value & ", " & FirstName.Value
'This is the error 
                    sht.Hyperlinks.Add Anchor:=sht.Cells(row, column).Address, Address:="", SubAddress:=ActiveWorkbook.Worksheets("ApplicantInfo").Cells(InfoRow, 1).Address, TextToDisplay:=linkDisplay



                    'end of validations
                End If
            End If
        End If
    End Sub
    Public Sub GetFirstEmptyRow()
        Set sht = ActiveWorkbook.Worksheets("ApplicantInfo")
        sht.Activate
        Range("A1").Select
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True

    End Sub
    Public Sub Save()

    End Sub
    Public Sub TimeBox_Change()

    End Sub

    Public Sub BranchBox_Change()
        'clear Date Box Values
        For i = DateBox.ListCount - 1 To 0 Step -1
            DateBox.RemoveItem i
        Next i
        'clear Time Box Values
        i = 0
        For i = TimeBox.ListCount - 1 To 0 Step -1
            TimeBox.RemoveItem i
        Next i
        'reset i to 0
        i = 0
        'populate dates
        Me.DateBox.List = Worksheets(BranchBox.Value).Range("A2:A31").Value
    End Sub
    Public Sub DateBox_Change()
        branch = BranchBox.Value
        Set sht = ActiveWorkbook.Worksheets(branch)
        dateSel = DateBox.Value

        'Get Row to scan
        For i = 2 To sht.Rows.Count
            Set cel = sht.Cells(i, 1)
            If cel.Value = dateSel Then
                rowOff = i
                Exit For
            End If
        Next i

        'Scan selected row for blank cells
        For i = 2 To sht.Columns.Count
            Set cel = sht.Cells(rowOff, i)
            If CStr(cel.Value) = "" Then
                Set matchingHeader = sht.Cells(1, i)
                TimeBox.AddItem matchingHeader.Text
            End If
        Next i
        Me.TimeBox.AddItem ("No Appointments Available")
    End Sub

这是错误的行：

sht.Hyperlinks.Add Anchor:=sht.Cells(row, column).Address, _
                   Address:="", _
                   SubAddress:=ActiveWorkbook.Worksheets("ApplicantInfo") _
                                  .Cells(InfoRow, 1).Address, _
                   TextToDisplay:=linkDisplay

非常感谢您的帮助！提前致谢！

Answer 1

sht.Hyperlinks.Add Anchor:=sht.Cells(row, column), _
              Address:="", _
              SubAddress:="'ApplicantInfo'!" & Cells(InfoRow, 1).Address(False, False), _
              TextToDisplay:=linkDisplay

不过，我通常会为这类事情使用实用程序方法。

例如类似：

Sub CreateHyperlink(FromCell As Range, ToCell As Range, Optional LinkText As String = "")
    Dim subAddr, txt

    subAddr = ToCell.Address(False, False)
    If FromCell.Worksheet.Name <> ToCell.Worksheet.Name Then
        subAddr = "'" & ToCell.Worksheet.Name & "'!" & subAddr
    End If

    txt = IIf(LinkText <> "", LinkText, FromCell.Value)
    If Len(txt) = 0 Then txt = "Go"

    With FromCell.Worksheet
        .Hyperlinks.Add Anchor:=FromCell, Address:="", _
                        SubAddress:=subAddr, TextToDisplay:=txt
    End With

End Sub