XL-Verweise mit VBA auflisten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
meinst du in etwa sowas ?
Und das wäre der Code für die Userform
Private Sub CommandButton1_Click()
Dim alinks()
Dim i As Integer
alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(alinks) Then
    For i = 1 To UBound(alinks)
        Me.ListBox1.AddItem alinks(i)
        Call LinkSeek("" & alinks(i) & "")
        Debug.Print alinks(i)
    Next i
End If
End Sub

Private Sub LinkSeek(lnkString As String)
'by Ramses
'Sucht in der gesamten Mappe nach einem Link und schreibt die
'gefundene Adresse in die Listbox Spalte 2
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String
For Each wks In Worksheets
    Set rng = wks.Cells.Find(What:=lnkString, _
        LookAt:=xlPart, LookIn:=xlFormulas)
    If Not rng Is Nothing Then
        sAddress = rng.Address
        Do
            Application.Goto rng, True
            Me.ListBox1.AddItem
            If chkWksName(wks.Name) = False Then
                Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = wks.Name
            End If
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = rng.Address
            Set rng = wks.Cells.FindNext(after:=ActiveCell)
            If rng.Address = sAddress Then Exit Do
        Loop
    End If
    NextStart:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub

Private Function chkWksName(wksString) As Boolean
'by Ramses
Dim i As Integer
With Me.ListBox1
    For i = 0 To .ListCount - 1
        Debug.Print .List(i)
        If .List(i, 1) = wksString Then
            chkWksName = True
            Exit Function
        End If
    Next i
End With
chkWksName = False
End Function

Gruss Rainer

Hallo
OK :-) Einverstanden
Ändere den Code für die Schalftfläche wie folgt:

Private Sub CommandButton1_Click()
    Dim alinks()
    Dim i As Integer, x As Integer, n As Integer, m As Integer
    Dim srcString As String
    alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(alinks) Then
        For i = 1 To UBound(alinks)
            srcString = ""
            Me.ListBox1.AddItem alinks(i)
            If InStr(1, alinks(i), "\") > 0 Then
                'für alle EXCEL Versionen
                For x = Len(alinks(i)) To 1 Step -1
                    Debug.Print Mid(alinks(i), x, 1)
                    If Mid(alinks(i), x, 1) = "\" Then
                        n = x
                        m = InStr(1, alinks(i), "xls") + 2
                        srcString = Left(alinks(i), x) & "[" & Mid(alinks(i), x + 1, m - x) & "]"
                        Debug.Print srcString
                        Call LinkSeek(srcString)
                        Exit For
                    End If
                Next x
            Else
                Call LinkSeek("" & alinks(i) & "")
            End If
        Next i
    End If
End Sub
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

XL-Verweise mit VBA auflisten

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread