Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1628to1632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren von Daten aus einem anderen Dokument

Kopieren von Daten aus einem anderen Dokument
10.06.2018 23:27:01
Daten
Guten Abend,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren von Daten aus einem anderen Dokument
11.06.2018 00:27:07
Daten
Hallo Lareena,
als 1. überprüft Du, ob eine bestimmte Datei schon geöffnet ist:
- If IsWorkbookOpen("Database_Kabeltechnik.xlsm") Then
- wenn 'Ja', das prüftst Du ob es diese Datei in einem bestimmten Ordner gibt:
  Quellcheck = Dir("\\ZAT005\Ma...)
- wenn wieder 'Ja', dann willst Du diese Datei nochmals öffnen, aber ohne Kennwort!
- und das wird die Stelle sein, wo Excel eben nachfragt!
- aber auch das dürfte schief gehen, denn 2 Dateien mit dem gleichen Dateinamen kann Excel nicht
  gleichzeitig offen haben.
Mein Vorschlag:
als 1. überprüft Du, ob eine bestimmte Datei schon geöffnet ist:
- If IsWorkbookOpen("Database_Kabeltechnik.xlsm") Then
- wenn 'Ja', das prüftst Du ob diese Datei aus einem bestimmten Ordner kommt:
- If Workbooks("Database_Kabeltechnik.xlsm").Path = _
     "\\ZAT005\Managementsysteme\4.LXX\17\...\Database_Kabeltechnik.xlsm" Then
  dann ist alle i.O., die richtige Dateri ist schon geöffnet (mit Kennwort)
- Else
  diese Datei schließen. da aus einen anderen Ordner
  überprüfen, ob es die Datei auch im gewünschten Ordner gibt
  wenn 'Ja', dann diese Datei öfnen, diesmal aber mit Kenntwort!
  Ansosten Fehlerhinweis-Meldung und Tschüsss sagen!
Der Zweig, der abläuft, wenn die allererste Überprüfung
(If IsWorkbookOpen("Database_Kabeltechnik.xlsm") Then
'False' ergibt,. sollt so in Deinem Code funktionieren.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: Kopieren von Daten aus einem anderen Dokument
12.06.2018 22:19:44
Daten
Hallo Luschi,
Vielen Dank, jetzt hat alles soweit funktioniert, der Vollständigkeit halber hier der abgeänderte Teil des Codes, der bisher ohne Probleme läuft:

If IsWorkbookOpen("Kabeltechnik_Database.xlsm") Then
Set QWB = Workbooks("Kabeltechnik_Database.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
Application.DisplayAlerts = False
Workbooks("Kabeltechnik_Database.xlsm").Close savechanges:=False ' Datei schließen
Application.DisplayAlerts = True
ThisWorkbook.Save

Das heißt, für mich nochmal zusammengefasst zum Verständnis: Die Funktion öffnet die Datei, wenn sie geschlossen ist, und gibt einen wie auch immer aussehenden Wert zurück aus dem hervorgeht, dass sie woanders geöffnet ist?
Das Problem mit dem Selbstständigmachen besteht allerdings weiterhin: Obwohl Datei 2 die einzige Excel-Datei ist, die aktuell geöffnet ist, öffnet sich „wie von Geisterhand“ in unterschiedlichen Abständen ein Fenster, in dem ich aufgefordert werde, das Passwort von Datei 1 einzugeben wenn ich den Schreibschutz aufheben möchte. Wie kann das sein? Datei 2 kennt ja das Passwort, von der aus dürfte die Anfrage also nicht ausgehen, aber andere Datei ist keine geöffnet.
Gibt es dafür auch eine Erklärung?
Danke im Voraus
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige