Блог

Главная - Вопросы по программированию - Перечислите внешние ссылки и разрешите пользователю ввести желаемое местоположение ячейки — что не так с этим кодом?

Перечислите внешние ссылки и разрешите пользователю ввести желаемое местоположение ячейки — что не так с этим кодом?

#excel #vba

Вопрос:

Я пытаюсь перечислить все внешние источники на листе 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

Что я делаю не так?

Кто-нибудь может помочь мне понять, как я могу заставить это работать?

Заранее благодарю вас за помощь!!

Комментарии:

1. Что именно происходит, когда вы пытаетесь запустить код?

2. Всплывают поля ввода и принимают ввод, но затем… ничего! Это как бы просто заканчивается. Но я могу подтвердить через диалоговое окно «Редактировать ссылки», что существуют ссылки на внешние источники.

Ответ №1:

Список Источников Ссылок

Выберите ячейку

 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 '" amp; Err.Number amp; "': " amp; 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 '" amp; Err.Number amp; "': " amp; Err.Description
    Resume ProcExit
End Sub
Метки: