Hallo liebes Forum,
ich hab ein kleines Excelproblem, bei dem ihr mir hoffentlich helfen könnt.
Ich habe eine Exceldatei (Basis), die mit einer zweiten Datei (Monat) verknüpft ist. In der Datei Basis gibt es eine Zelle in der, der entsprechende Monat ausgewählt wird, dadurch wird das Makro unten ausgelöst.
Das Problem auf Windows XP läuft das ganze in 3 Minuten ab und die Datei ist umgestellt.
In der Firma wird Windows 7 mit entsprechendem Excel 2010 und neuen PCs benutzt . Hier braucht das Makro geschlagene 1,5 Std !!! bis die Änderung durchgeführt wird.
Hab ich einen Fehler im Makro oder gibt es einen neuen Befehl, der die Verlinkung ändert und schneller ist???
Hoffe ihr könnt mir helfen.
Vielen Dank
Vindariel
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
Select Case .Address
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="xxxxx"
Case Is = "$P$1", "$S$1" ' in P steht der Monat in S das Jahr
Dim neuerLink
y = MsgBox("Es wird auf den gewählten Monat umgeschaltet. Bitte OK anklicken. Dieser Vorgang dauert ca. 3 MINUTEN!!! BITTE WARTEN!!!", vbCritical, "W I C H T I G ! ! ! ")
Application.ScreenUpdating = False
Sheets("Stammdaten").Select
ActiveSheet.Unprotect Password:="xxxxx"
Select Case Sheets("Einteilung").Range("P1").Value
Case 1
Sheets("Stammdaten").Range("BN10").Value = ActiveWorkbook.LinkSources 'aktuelle Verlinkung
neuerLink = Sheets("Stammdaten").Range("BN6").Value & Sheets("Stammdaten").Range("BN7").Value _
& " Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls" 'Zusammensetzung des neuen Pfades und Dateinamen
If Dir(neuerLink) <> "" Then
'Überprüfung ob die neue Datei, auf die verlinkt wird, existiert, wenn ja wird der Link gewechselt ansonsten Abbruch durch Else
ActiveWorkbook.ChangeLink Name:=Sheets("Stammdaten").Range("BN10").Value, _
newname:=Sheets("Stammdaten").Range("BN6").Value & Sheets("Stammdaten").Range("BN7").Value _
& " Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls", Type:=xlLinkTypeExcelLinks
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxxxx"
Sheets("Einteilung").Select
Application.ScreenUpdating = True
y = MsgBox("auf Januar umgeschaltet.")
Else:
y = MsgBox("Monatdatei Januar " & Sheets("Stammdaten").Range("BR3").Value & ".xls existiert noch nicht bitte anlegen")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxxxx"
Sheets("Einteilung").Select
Application.ScreenUpdating = True
End If
Case 2 'Case 2 bis 12 sind identisch mit Case 1 nur mit den anderen Monatsnamen
End Select
End Select
End With
End Sub
|