VBA Jahr in Verknüpfung erkennen und aktualisieren

Sub Makro1() Range("E4").Select ActiveCell.FormulaR1C1 = _ "=IF(LOOKUP(RC[-3],'[KALENDER_2016.xlsx]JanJun'!R3C3:R3C183,'[KALENDER_2016.xlsx] Jan-Jun'!R5C3:R5C183)>0,LOOKUP(RC[-3],'[KALENDER_2016.xlsx]JanJun'!R3C3:R3C183, '[KALENDER_2016.xlsx]Jan-Jun'!R5C3:R5C183),"""")" Range("E4").Select Selection.AutoFill Destination:=Range("E4:E34"), Type:=xlFillDefault Range("E4:E34").Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Verknuepfung_aktualisieren() Sheets("Januar").Select Range("B2").Select ChDir "D:\KALENDER" ActiveWorkbook.ChangeLink Name:="D:\KALENDER_2015.xlsx", NewName _ :="D:\KALENDER_2016", Type:=xlExcelLinks End Sub

Sub Verknuepfung_aktualisieren() Sheets("Januar").Select Range("B2").Select ChDir "D:\KALENDER" ActiveWorkbook.ChangeLink Name:="D:\KALENDER_2016.xlsx", NewName _ :="D:\KALENDER_" &"Range("B2"), Type:=xlExcelLinks End Sub

Sub Verknuepfung_aktualisieren() Sheets("Januar").Select Range("B2").Select ActiveCell.FormulaR1C1 = Year(Now) ActiveWorkbook.ChangeLink Name:="D:\KALENDER_2015.xlsx", NewName _ :="D:\KALENDER_" & (Range("B2")), Type:=xlExcelLinks End Sub

Sub Verknuepfung_aktualisieren() Dim strJahr As String Dim varLinks, strLinkAlt As String, strLinkNeu As String Dim wkb As Workbook Dim msgPrompt$, msgTitle$, msgButtons As Long Set wkb = ActiveWorkbook msgTitle = "Aktualisierung Verknüpfung in " & wkb.Name msgButtons = vbInformation + vbOKOnly 'alle Verknüpfungen zu Excel-Dateien einer Variablen zuweisen varLinks = wkb.LinkSources(Type:=xlExcelLinks) 'Verknüpfung prüfen If Not IsArray(varLinks) Then msgPrompt = "Die Arbeitsmappe enthält keine Verknüpfungen." MsgBox msgPrompt, msgButtons, msgTitle Else strLinkAlt = varLinks(1) If Not LCase(strLinkAlt) Like "*kalender_####.xlsx" Then msgPrompt = "Die 1. Verknüfung " & strLinkAlt & vbLf _ & "enthält nicht den Ausdruck ""Kalender_####.xlsx""" MsgBox msgPrompt, msgButtons, msgTitle Else 'Jahr für Link aus Zelle auslesen strJahr = wkb.Sheets("Januar").Range("B2").Text 'neue Verknüpfung zusammenbauen strLinkNeu = VBA.Replace(strLinkAlt, _ Find:=Right(strLinkAlt, 9), Replace:=strJahr & ".xlsx") 'Prüfung ob Datei existiert If Dir(strLinkNeu) = "" Then msgPrompt = "Die Datei für das Jahr " & strJahr & vbLf _ & strLinkNeu & vbLf _ & "existiert nicht." & vbLf _ & "Link-alt: " & strLinkAlt MsgBox msgPrompt, msgButtons, msgTitle Else If LCase(strLinkAlt) = LCase(strLinkNeu) Then msgPrompt = "Die Verknüpfung ist schon aktuell." & vbLf _ & "Dateiname: " & strLinkAlt MsgBox msgPrompt, msgButtons, msgTitle Else 'Verknüpfung ersetzen wkb.ChangeLink Name:=strLinkAlt, _ NewName:=strLinkNeu, Type:=xlExcelLinks End If End If End If End If End Sub

Hallo Franz,
vielen Dank für Deine Arbeit, das sieht richtig gut aus! ich habe Deinen Code eingebaut und lasse dann gleich die aktuelle Datei abspeichern:

Sub Verknuepfung_aktualisieren_und_neue_Datei()
Dim i As Integer
Dim j As Integer
Dim strJahr As String
Dim varLinks, strLinkAlt As String, strLinkNeu As String
Dim wkb As Workbook
Dim msgPrompt$, msgTitle$, msgButtons As Long
Set wkb = ActiveWorkbook
For i = 1 To Sheets.Count
ActiveWorkbook.Sheets(i).Unprotect Password:=""
Next
Sheets("Januar").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = Year(Now) + 1
msgTitle = "Aktualisierung Verknüpfung in " & wkb.Name
msgButtons = vbInformation + vbOKOnly
'alle Verknüpfungen zu Excel-Dateien einer Variablen zuweisen
varLinks = wkb.LinkSources(Type:=xlExcelLinks)
'Verknüpfung prüfen
If Not IsArray(varLinks) Then
msgPrompt = "Die Arbeitsmappe enthält keine Verknüpfungen."
MsgBox msgPrompt, msgButtons, msgTitle
Else
strLinkAlt = varLinks(1)
If Not LCase(strLinkAlt) Like "*kalender_####.xlsx" Then
msgPrompt = "Die 1. Verknüfung " & strLinkAlt & vbLf _
& "enthält nicht den Ausdruck ""Kalender_####.xlsx"""
MsgBox msgPrompt, msgButtons, msgTitle
Else
'Jahr für Link aus Zelle auslesen
strJahr = wkb.Sheets("Januar").Range("B2").Text
'neue Verknüpfung zusammenbauen
strLinkNeu = VBA.Replace(strLinkAlt, _
Find:=Right(strLinkAlt, 9), Replace:=strJahr & ".xlsx")
'Prüfung ob Datei existiert
If Dir(strLinkNeu) = "" Then
msgPrompt = "Die Datei für das Jahr " & strJahr & vbLf _
& strLinkNeu & vbLf _
& "existiert nicht." & vbLf _
& "Link-alt: " & strLinkAlt
MsgBox msgPrompt, msgButtons, msgTitle
Else
If LCase(strLinkAlt) = LCase(strLinkNeu) Then
msgPrompt = "Die Verknüpfung ist schon aktuell." & vbLf _
& "Dateiname: " & strLinkAlt
MsgBox msgPrompt, msgButtons, msgTitle
Else
'Verknüpfung ersetzen
wkb.ChangeLink Name:=strLinkAlt, _
NewName:=strLinkNeu, Type:=xlExcelLinks
End If
End If
End If
End If
ActiveSheet.Shapes.Range(Array("Schaltfläche 1")).Select
Selection.Delete
ActiveWorkbook.SaveAs Filename:= _
"D:\KALENDER\Zuschläge_" & (Range("B2")), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
For j = 1 To Sheets.Count
ActiveWorkbook.Sheets(j).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True,  _
Password:=""
Next
ActiveWorkbook.Save
End Sub

Noch mal Dank an Dich, hat mir auch gleich noch einen bisschen besseren Einblick in VBA verschafft :-)
Gruß,
Werner

Hallo, ich schon wieder ;-)
Die o.g. Sachen funktionieren ja wirklich wunderbar, nun zusätzlich die Frage:
Wie würde man es realisieren, statt einer ZWEI Verknüpfungen zu aktualisieren?
Eine Verknüpfung ein Jahr vor, 2015 zu 2016 bzw. Zelle B2 = Year(Now) +1 (bereits oben gelöst),
eine weitere das vorhergehende Jahr einen vor (hier dann 2014 zu 2015)? (Dateiname beinhaltet "Stunden_xxxx.xlsm")
Ich habe schon ein bisschen experimentiert, u.a. habe ich versucht eine Kopie des oben stehenden Codes (Variablenzuweisungen angepasst) zu verwenden. Dabei bekomme ich allerdings die Prüfung der Verknüpfungen ("Die 1. [bzw. 2.] Verknüpfung enthält nicht den Ausdruck..") nicht separiert und dementsprechend die Fehlermeldung.
Kann mir da jemand weiterhelfen?
Dank im Voraus
Werner

Bewerten Sie hier bitte das Excel-Portal

Beliebteste Forumthreads (12 Monate)

VBA Jahr in Verknüpfung erkennen und aktualisieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Jahr in Verknüpfung erkennen und aktualisieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread