首页 > 解决方案 > 列出外部链接并允许用户输入所需的单元格位置 - 此代码有什么问题?

问题描述

我正在尝试在 Excel 工作表中列出所有外部源,但我希望用户能够选择他们希望开始列出链接的单元格。

我已经尝试了以下代码,但我无法让它工作..

Sub ListExternalLink()

    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    
    xRln = InputBox("Which row #?", "Listing external link..", "Numbers Only")
    xCln = InputBox("Which column #?", "Listing external link..", "Numbers Only")
    
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
      For Each link In wb.LinkSources(xlExcelLinks)
        Application.ActiveSheet.Cells(xRln, xCln).Value = link
        xRln = xRln + 1
      Next link
    End If
    
End Sub

我究竟做错了什么?

谁能帮我弄清楚如何让它工作?

提前谢谢你的帮助!!

标签: excelvba

解决方案


列出链接源

选择一个单元格

Sub ListExternalLinksCell()
    On Error GoTo ClearError
    
    Const pTitle As String = "List External Links"
    
    Dim defValue As String
    If TypeOf Selection Is Range Then
        defValue = Selection.Address
    End If
    
    On Error Resume Next
    Dim FirstCell As Range
    Set FirstCell = Application.InputBox("Select the first cell", _
        pTitle, defValue, , , , , 8)
    On Error GoTo ClearError
    
    If FirstCell Is Nothing Then
        MsgBox "Canceled by user.", vbExclamation, pTitle
        Exit Sub
    End If
    
    Set FirstCell = FirstCell.Cells(1)
    Dim wb As Workbook: Set wb = FirstCell.Worksheet.Parent
    
    Dim lSources As Variant: lSources = wb.LinkSources(xlExcelLinks)
    If IsEmpty(lSources) Then
        MsgBox "No link sources found.", vbExclamation, pTitle
        Exit Sub
    End If
    
    Dim lSource As Variant
    For Each lSource In lSources
        FirstCell.Value = lSource
        Set FirstCell = FirstCell.Offset(1)
    Next lSource

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume ProcExit
End Sub

输入行和列

Sub ListExternalLinksRC()
    On Error GoTo ClearError
    
    Dim xRln As Variant, xCln As Variant
    xRln = Application.InputBox("Which row #?", "Listing external link..", "Numbers Only", , , , , 1)
    If xRln = False Then Exit Sub
    xCln = Application.InputBox("Which column #?", "Listing external link..", "Numbers Only", , , , , 1)
    If xCln = False Then Exit Sub
    
    Dim xRow As Long: xRow = CLng(xRln)
    Dim xCol As Long: xCol = CLng(xCln)
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim Link As Variant
    If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
        For Each Link In wb.LinkSources(xlExcelLinks)
            Debug.Print Link
            ws.Cells(xRow, xCol).Value = Link
            xRow = xRow + 1
        Next Link
    End If

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume ProcExit
End Sub

推荐阅读