Excel VBA-将超链接添加到另一个工作簿时出错

Question

我已经编写了这段代码，以从一个工作簿中获取数据，将其放入数组中，然后将数据放置在另一工作簿中的空行中。 它一直起作用，直到在For循环中添加超链接的i = 25为止。 超链接实际上是正确添加的，并且可以正常运行，但是当我单步执行该行时，即使该行正确添加了超链接，它也会给我一个“应用程序定义的错误或对象定义的错误”。

任何帮助将不胜感激。 我已经坚持了几天，并尝试了许多调整。

Private Sub CopyDataToMatrix()

'This macro copies the data from the process sheet & automatically pastes it into
'the matrix.

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim Data(1 To 26)
    Dim EmptyRow As Range
    Dim strSearch As String
    Dim rngSearch As Range
    Dim rowNum As Integer

    Set wb1 = ActiveWorkbook
    Set wb2 = Workbooks.Open("***ForPrivacy***")

    Set ws1 = wb1.Sheets("ProcessData")
    Set ws2 = wb2.Sheets("2016")

    'Put all of the data into an array:
     Data(1) = ws1.Range("B57").Value     
     Data(2) = ws1.Range("B3").Value      
     Data(3) = ws1.Range("B4").Value      
     Data(4) = ws1.Range("B5").Value      
     Data(5) = ws1.Range("F7").Value      
     Data(6) = ws1.Range("B6").Value      
     Data(7) = ws1.Range("B7").Value      
     Data(8) = ws1.Range("F8").Value    
     Data(9) = ws1.Range("B8").Value     
     Data(10) = ws1.Range("B9").Value    
     Data(11) = ws1.Range("B10").Value    
     Data(12) = ws1.Range("F9").Value     
     Data(13) = ws1.Range("F4").Value    
     Data(14) = ws1.Range("F5").Value     
     Data(15) = ws1.Range("F6").Value    
     Data(16) = ws1.Range("G4").Value     
     Data(17) = ws1.Range("G5").Value     
     Data(18) = ws1.Range("G6").Value     
     Data(19) = ws1.Range("H4").Value     
     Data(20) = ws1.Range("H5").Value    
     Data(21) = ws1.Range("H6").Value     
     Data(22) = ws1.Range("I4").Value    
     Data(23) = ws1.Range("I5").Value     
     Data(24) = ws1.Range("I5").Value     
     Data(25) = Left(wb1.Name, 8)         


 'IM MATRIX:
    'Look to see if the row already exists in IM Matrix with the current file name, and if so overwrite it:
    strSearch = Left(wb1.Name, 8)
    Set rngSearch = ws2.Range("Y:Y")

    If Application.CountIf(rngSearch, strSearch) > 0 Then
        rowNum = Application.Match(strSearch, rngSearch, 0)
        With ws2
            Set EmptyRow = .Cells(rowNum, 1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
            Next i
                For i = 25 To 25
                    EmptyRow.Offset(0, i - 1).Value = ws2.Hyperlinks.Add(EmptyRow.Offset(0, i - 1), wb1.FullName, , "Click to go to IML file.", Data(i))
            Next i
        End With

     'If the file name isn't already in IM Matrix, then enter data in new row:
     Else
        With ws2
            Set EmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
            Next i
                For i = 25 To 25
                    **''HERE IS WHERE THE CODE BUGS:**
                    **EmptyRow.Offset(0, i - 1).Value = ws2.Hyperlinks.Add(EmptyRow.Offset(0, i - 1), wb1.FullName, , "Click to go to IML file.", Data(i))**
            Next i
        End With
    End If

     'Close & save IM Matrix file:
     wb2.Close SaveChanges:=True


End Sub

这是在@JMichael的帮助下工作的解决方案：

Private Sub CopyDataToMatrix()

'This macro copies the data from the process sheet & automatically pastes it into
'the matrix.

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim Data(1 To 26)
    Dim EmptyRow As Range
    Dim strSearch As String
    Dim rngSearch As Range
    Dim rowNum As Integer

    Set wb1 = ActiveWorkbook
    Set wb2 = Workbooks.Open("***ForPrivacy***")

    Set ws1 = wb1.Sheets("ProcessData")
    Set ws2 = wb2.Sheets("2016")

    'Put all of the data into an array:
     Data(1) = ws1.Range("B57").Value     
     Data(2) = ws1.Range("B3").Value      
     Data(3) = ws1.Range("B4").Value      
     Data(4) = ws1.Range("B5").Value      
     Data(5) = ws1.Range("F7").Value      
     Data(6) = ws1.Range("B6").Value      
     Data(7) = ws1.Range("B7").Value      
     Data(8) = ws1.Range("F8").Value    
     Data(9) = ws1.Range("B8").Value     
     Data(10) = ws1.Range("B9").Value    
     Data(11) = ws1.Range("B10").Value    
     Data(12) = ws1.Range("F9").Value     
     Data(13) = ws1.Range("F4").Value    
     Data(14) = ws1.Range("F5").Value     
     Data(15) = ws1.Range("F6").Value    
     Data(16) = ws1.Range("G4").Value     
     Data(17) = ws1.Range("G5").Value     
     Data(18) = ws1.Range("G6").Value     
     Data(19) = ws1.Range("H4").Value     
     Data(20) = ws1.Range("H5").Value    
     Data(21) = ws1.Range("H6").Value     
     Data(22) = ws1.Range("I4").Value    
     Data(23) = ws1.Range("I5").Value     
     Data(24) = ws1.Range("I5").Value     
     Data(25) = Left(wb1.Name, 8)         


 'IM MATRIX:
    'Look to see if the row already exists in IM Matrix with the current file name, and if so overwrite it:
    strSearch = Left(wb1.Name, 8)
    Set rngSearch = ws2.Range("Y:Y")

    If Application.CountIf(rngSearch, strSearch) > 0 Then
        rowNum = Application.Match(strSearch, rngSearch, 0)
        With ws2
            Set EmptyRow = .Cells(rowNum, 1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
                Next i
            ws2.Hyperlinks.Add EmptyRow.Offset(0, 24), wb1.FullName, , "Click to go to IML file.", Data(25)

        End With

     'If the file name isn't already in IM Matrix, then enter data in new row:
     Else
        With ws2
            Set EmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
                For i = LBound(Data) To 24
                    EmptyRow.Offset(0, i - 1).Value = Application.Index(Data, i)
                Next i                        
            ws2.Hyperlinks.Add EmptyRow.Offset(0, 24), wb1.FullName, , "Click to go to IML file.", Data(25)

        End With
    End If

     'Close & save IM Matrix file:
     wb2.Close SaveChanges:=True


End Sub

Answer 1

根据我录制时获得的代码，创建超链接似乎需要删除ws2.Hyperlinks...之前的所有内容。 超链接创建代码包含用于放置链接的单元格，因此我认为它固有地填充了该单元格的.Value 。

确保更新其中涉及Application.CountIf(rngSearch, strSearch) > 0返回为True的情况的代码，因为它试图做同样的事情。

您也可以在添加超链接的地方放掉For循环，因为您并不是真正在循环。 您可以在创建超链接之前仅增加i ，也可以仅硬编码值。