ich habe Probleme mit einem VBA-Code und komme trotz Recherche in diversen
Foren nicht drauf, wo der Hund begraben liegt.
Es geht um folgendes: Ich habe zwei Excel-Dateien. Datei 1 importiert regelmäßig eine Tabelle von Sharepoint und verarbeitet diese zusammen mit Daten, die ich manuell dort eingebe, zu Diagrammen. Diese Diagramme sollen auf einem anderen Rechner immer möglichst am aktuellsten Stand angezeigt werden. Ich habe nach eingehender Suche im Internet keinen Weg gefunden, wie ich das in einer Datei realisieren kann, weil das Vorhandensein von Makros ja die Option Datei freigeben ausschließt. Deswegen habe ich eine zweite Datei, Datei 2, angelegt, die in Abständen von 10 Minuten Datei 1 öffnen soll, das Blatt mit den Diagrammen und diverse Tabellen kopieren soll, und Datei 1 wieder schließen soll, und zwar abhängig davon ob Datei 1 woanders geöffnet ist oder nicht entweder schreibgeschützt oder unter Eingabe des Passworts von Datei 1. Der Grund, warum ich sie nicht immer schreibgeschützt öffne, ist einfach der, dass
außer mir niemand die Datei manuell bearbeitet, wenn ich also im Urlaub bin, wären die Diagramme nicht am aktuellsten Stand (so zumindest meine Überlegung, bitte korrigiert mich wenn ich falsch liege ).
Ich möchte noch vornewegschicken, dass ich Amateurin bin, ich habe eigentlich nie programmieren gelernt sondern mein bisheriges (Halb?)Wissen bis auf ein paar Basics aus der Schulzeit aus dem Internet zusammengetragen.
Der Code im Modul von Datei 2 dafür sieht so aus:
Function IsWorkbookOpen(strWB As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
Public Sub Copy()
On Error Resume Next
Worksheets("Verlauf").Unprotect emxc2
Worksheets("Tabelle1").Unprotect emxc2
Worksheets("GenData").Unprotect emxc2
Worksheets("Vorwoche").Unprotect emxc2
On Error GoTo 0
Application.ScreenUpdating = False
Dim QWB As Workbook, ZWB As Workbook
Dim QWS As Worksheet, ZWS As Worksheet
Application.DisplayAlerts = False 'Schaltet Fehlermeldung zum Löschen des Blattes
vorrübergehend aus
On Error Resume Next 'Zeile ohne Fehlermeldung überspringen, wenn keine Tabelle
"Verlauf" vorhanden
ThisWorkbook.Worksheets("Verlauf").Delete
On Error GoTo 0
Application.DisplayAlerts = True
If IsWorkbookOpen("Database_Kabeltechnik.xlsm") Then
'Überprüfen, ob Quelldatei vorhanden ist, sonst Fehlermeldung und Abbruch der
Aktualisierung
Quellcheck = Dir("\\ZAT005\Managementsysteme\4.LXX\17\Auswertungsdateien
Sharepoint\Kabeltechnik\Database_Kabeltechnik.xlsm")
If Quellcheck = "" Then
MsgBox ("Dateipfad ungültig! Aktualisierung wurde abgebrochen.")
Exit Sub
End If
Workbooks.Open
Filename:="\\ZAT005\Managementsysteme\4.LXX\17\Auswertungsdateien
Sharepoint\Kabeltechnik\Database_Kabeltechnik.xlsm", ReadOnly:=True 'schreibgeschützt
öffnen
Set QWB = Workbooks("Database_Kabeltechnik.xlsm") ' Quelle, aus der die
kopiert werden soll
Set ZWB = ThisWorkbook ' Ziel, Workbook mit diesem Makro
Set QWS = QWB.Worksheets("Verlauf") ' Quelle
Set ZWS = ZWB.Worksheets("Tabelle1") ' Ziel
Set rangeQWS = QWB.Worksheets("Verlauf").Range("A10:BB19")
Set rangeZWS = ZWB.Worksheets("Vorwoche").Range("A10.BB19")
QWS.Copy ZWS ' kopieren
rangeQWS.Copy rangeZWS
Set rangeZeitenQ = QWB.Worksheets("ZeitKosten").Range("A1:I53")
Set rangeZeitenZ = ZWB.Worksheets("GenData").Range("A1:I53")
rangeZeitenQ.Copy rangeZeitenZ
Workbooks("Database_Kabeltechnik.xlsm").Close savechanges:=False ' Datei schließen
ThisWorkbook.Save
Else
Workbooks.Open
Filename:="\\ZAT005\Managementsysteme\4.LXX\17\Auswertungsdateien
Sharepoint\Kabeltechnik\Database_Kabeltechnik.xlsm", WriteResPassword:="enter"
Set QWB = Workbooks("Database_Kabeltechnik.xlsm") ' Quelle, aus der die
kopiert werden soll
Set ZWB = ThisWorkbook ' Ziel, Workbook mit diesem Makro
Set QWS = QWB.Worksheets("Verlauf") ' Quelle
Set ZWS = ZWB.Worksheets("Tabelle1") ' Ziel
Set rangeQWS = QWB.Worksheets("Verlauf").Range("A10:BB19")
Set rangeZWS = ZWB.Worksheets("Vorwoche").Range("A10.BB19")
QWS.Copy ZWS ' kopieren
rangeQWS.Copy rangeZWS
Set rangeZeitenQ = QWB.Worksheets("ZeitKosten").Range("A1:I53")
Set rangeZeitenZ = ZWB.Worksheets("GenData").Range("A1:I53")
rangeZeitenQ.Copy rangeZeitenZ
Workbooks("Database_Kabeltechnik.xlsm").Close savechanges:=True ' Datei schließen
ThisWorkbook.Save
End If
Worksheets("Verlauf").Protect emxc2
Worksheets("Tabelle1").Protect emxc2
Worksheets("GenData").Protect emxc2
Worksheets("Vorwoche").Protect emxc2
Application.ScreenUpdating = True
End Sub
Das Problem ist: Der Code funktioniert nicht immer. Regelmäßig bekomme ich eine Aufforderung zur Eingabe des Passworts von Datei 1, obwohl ich ja eigentlich dachte dass ich das ausschließe, indem ich vorher prüfe ob Datei 1 geöffnet ist, und mit WriteResPassword das Passwort eingebe. Wenn sich Datei 1 schreibgeschützt öffnet, ist es außerdem regelmäßig so, dass sie sich nicht automatisch wieder schließt bzw. die Meldung erscheint ob die Änderungen gespeichert werden sollen oder nicht, obwohl ich eigentlich der Meinung war durch SaveChanges= True bzw. False das für jeden Fall eindeutig vorgegeben zu haben. Dazu muss ich allerdings sagen, dass ich die Funktion, die testet, ob die Datei geöffnet ist, nicht selbst geschrieben habe, sondern kopiert habe und ehrlich gestanden auch gar nicht verstehe, was genau sie tut. Der nächste Punkt der mich irritiert ist, dass sich das Programm gelegentlich selbstständig macht, ich also zur Eingabe des Passworts von Datei 1 aufgefordert werde, obwohl ich zu dem Zeitpunkt weder Datei 1 noch Datei 2 öffne oder bearbeite. Das kann ich mir beim besten Willen nicht erklären.
Hat jemand von euch eine Erklärung für die von mir geschilderten
Erscheinungen? Wie kann ich diese Fehlfunktionen verhindern?
Ich danke im Voraus für eure Unterstützung
Lareena