Verknüpfungen ändern und auflisten

Sub Change_Link() Dim myLinks As Variant Dim NewSource As String Dim OldSource As String Dim i As Integer If MsgBox("Alle Verknüpfungen in der Mappe ändern?", vbYesNo + vbQuestion, "xyx: Info") = vbNo _ Then MsgBox "Es sind keine Änderungen erfolgt." Exit Sub End If myLinks = ThisWorkbook.LinkSources For i = 1 To UBound(myLinks) OldSource = CStr(myLinks(i)) NewSource = Application.GetOpenFilename() ThisWorkbook.ChangeLink Name:=OldSource, Newname:=NewSource Next ' ThisWorkbook.UpdateLink End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Formeln_suchen_extern() 'Auflistung aller Formeln mit Bezug zu einer anderen Mappe Dim Wks As Worksheet, wksFormeln As Worksheet Dim blnIndex As Boolean, rngF As Range, rngFormeln As Range Dim lngZeile As Long, Kopf Application.ScreenUpdating = False blnIndex = False lngZeile = 2 For Each Wks In ActiveWorkbook.Worksheets Set rngFormeln = Nothing On Error Resume Next Set rngFormeln = Wks.Cells.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not rngFormeln Is Nothing Then For Each rngF In rngFormeln If InStr(rngF.FormulaLocal, "\[") > 0 Then If blnIndex = False Then Set wksFormeln = Worksheets.Add(after:=Sheets(Worksheets.Count)) Kopf = Array("Blatt", "Zelle", "Zeile", "Spalte", "Formel") With wksFormeln .Name = "ext.Formeln" .Range("A1:E1") = Kopf End With blnIndex = True End If With wksFormeln .Cells(lngZeile, 1) = Wks.Name .Cells(lngZeile, 2) = rngF.Address(0, 0) .Cells(lngZeile, 3) = rngF.Row .Cells(lngZeile, 4) = rngF.Column .Cells(lngZeile, 5) = "'" & rngF.FormulaLocal .Columns.AutoFit End With lngZeile = lngZeile + 1 End If Next rngF End If Next Wks Range("A1").Select If blnIndex = False Then MsgBox "Keine externen Bezüge vorhanden.", , "" Else wksFormeln.Activate End If Application.ScreenUpdating = True End Sub

Hallo,
schreibt einfach drunter:

Sub Formeln_suchen_extern()
'Auflistung aller Formeln mit Bezug zu einer anderen Mappe
Dim Wks As Worksheet, wksFormeln As Worksheet
Dim rngF As Range, rngFormeln As Range
Dim lngZeile As Long
Const cstrWks As String = "ext.Formeln"
Application.ScreenUpdating = False
For Each Wks In ActiveWorkbook.Worksheets
Set rngFormeln = Nothing
On Error Resume Next
Set rngFormeln = Wks.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngFormeln Is Nothing Then
For Each rngF In rngFormeln
If InStr(rngF.FormulaLocal, "\[") > 0 Then
On Error Resume Next
Set wksFormeln = Worksheets(cstrWks)
On Error GoTo 0
If wksFormeln Is Nothing Then
Set wksFormeln = Worksheets.Add(after:=Sheets(Worksheets.Count))
With wksFormeln
.Name = cstrWks
.Range("A1:E1") = Array("Blatt", "Zelle", "Zeile", "Spalte", "Formel")
End With
End If
With wksFormeln
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZeile, 1) = Wks.Name
.Cells(lngZeile, 2) = rngF.Address(0, 0)
.Cells(lngZeile, 3) = rngF.Row
.Cells(lngZeile, 4) = rngF.Column
.Cells(lngZeile, 5) = "'" & rngF.FormulaLocal
.Columns.AutoFit
End With
End If
Next rngF
End If
Next Wks
Range("A1").Select
If wksFormeln Is Nothing Then
MsgBox "Keine externen Bezüge vorhanden.", , ""
Else
wksFormeln.Activate
End If
Application.ScreenUpdating = True
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Verknüpfungen ändern und auflisten

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread