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 ，也可以僅硬編碼值。