声明创buildexcel vba超链接引发运行时'1004'错误

所以我有几个关于excel VBA的问题,当我蹒跚学习所有这些时,我感谢你们对我的支持。 你的答案是一个巨大的帮助和学习经验。

到目前为止,我有一个子程序,其主要职责是通过各种validation和dynamiccombobox写入通过用户表单收集的所有值。 我最后的任务是让这个子程序分配一个超链接到前一个循环select的位置。 但与我目前的语法,我得到一个“运行时错误'1004'方法'_default'对象'范围'失败”。 一些研究certificate,单元坐标需要一个.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 

帮助非常感谢! 提前致谢!

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

虽然我通常使用这种types的东西的实用工具方法。

例如:

 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