Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1480to1484
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

Alle Diagramme aus mehreren Workbooks sammeln

Alle Diagramme aus mehreren Workbooks sammeln
09.03.2016 10:13:43
Alex
Hallo Zusammen,
habe einen Ordner mit mehreren *.xlsx Dateien. Jede der Dateien hat mehrere Arbeitsblätter auf denen z.T. Diagramme sind.
Wie kann ich sämtliche Sheets in allen diesen *.xlsx Dateien durchgehen und dann alle Digramme die z.B. im Diagrammnamen "TS" enthalten in eine neue *.xlsx Datei (auf das erste Sheet untereinander) oder/und nacheinander in ein neues Word-Dokument bringen?
Wäre sehr dankbar für eine Lösung, da es aktuelle ne Meeeeeenge händischer Aufwand ist.
Danke :-)

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

Betreff
Datum
Anwender
Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
09.03.2016 11:35:09
Beverly
Hi Alex,
versuche es ao:
Sub DiasKopieren()
Dim strMappe As String
Dim strPfad As String
Dim wksTab As Worksheet
Dim chrDia As ChartObject
Dim lngZaehler As Long
Dim dblOben As Double
strPfad = "I:\Z_Test\"  ' ""
Workbooks.Open Filename:=strPfad & strMappe
For Each wksTab In ActiveWorkbook.Worksheets
With wksTab
If .ChartObjects.Count > 0 Then
For Each chrDia In .ChartObjects
If InStr(chrDia.Name, "TS") > 0 Then
chrDia.Copy
ThisWorkbook.Worksheets("Tabelle1").Paste
End If
Next chrDia
End If
End With
Next wksTab
ActiveWorkbook.Close True
strMappe = Dir
Loop
.ChartObjects(1).Top = 0
For lngZaehler = 2 To .ChartObjects.Count
dblOben = .ChartObjects(lngZaehler - 1).Top + .ChartObjects(lngZaehler - 1).Height
.ChartObjects(lngZaehler).Top = dblOben
Next lngZaehler
End With
Application.ScreenUpdating = False
End Sub


Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
09.03.2016 14:02:08
Alex
Vielen Dank Karin,
allerdings wird ist das neu erzeugte File leer (anscheinend wird nichts eingefügt). Das Makro läuft sauber alle Dateien durch, kopiert aber nichts raus!?

AW: Alle Diagramme aus mehreren Workbooks sammeln
09.03.2016 14:50:33
Beverly
Hi Alex,
kann ich nicht nachvollziehen.
Führe mal nach dem Kopieren dieses Makro aus:
Sub DiaAnzahl()
MsgBox ActiveSheet.ChartObjects.Count
End Sub

Falls als Ergebnis 0 ausgegeben wird, wurde tatsächlich nichts kopiert. Könnte es denn sein, dass in keinem der Diagramm-Namen "TS" steht?


Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
11.03.2016 14:38:22
Alex
Hi Beverly,
also da sind schon Chartobjects drin. Das Skript geht auch ordnungsgemäß alle Dateien durch. Allerdings gibts anscheinend ein Problem damit, welches Blatt beim Einfügen gerade aktiv ist.
Hab wie folgt angepasst:

If .ChartObjects.Count > 0 Then
For Each chrDia In .ChartObjects
If InStr(chrDia.Name, "TS") > 0 Then
chrDia.Copy
Workbooks(1).Sheets(1).Activate
Workbooks(1).Sheets(1).Cells(1,1).Select  'Zelle "A1" im WB1/Sheet1 anwählen
ActiveCell.Value = Workbooks(2).Name      'Dateiname der Quell-WB hineinschreiben
Workbooks(1).Sheets(1).Cells(2,1).Select  'Zelle "A2" im WB1/Sheet1 anwählen
Workbooks(1).Worksheets(1).Paste          'Diagramm aus Quell-WB einfügen
End If
Next chrDia
End IF
ABER: Ist natürlich bisschen unsauber da irgendwie zwieschen den Workbooks hin und her zu aktiveren. Das setzt nämlich voraus, dass das Workbook aus dem ich den Aufruf starte immer die Nr. 1 ist "Workbooks(1)" und das aus dem heraus kopiert wird immer die Nr. 2 "Workbooks(2)".
Kann man da nicht feste "Zeiger" auf die Workbooks definieren, mit denen man dann arbeitet?

Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
11.03.2016 15:06:12
Steve
Hallo Alex,
gleich vornweg, Beverly's Makro läuft bei mir wie eine eins. Warum bei dir nicht kann ich nicht nachvollziehen, glaube aber eher dass deine Diagramme nicht richtig benannt sind oder du den Diagrammtitel statt dem -Namen meinst.
Nichtsdestotrotz will ich dir zu deinem Problem der Workbooks ein paar Tipps geben:
Erstelle dir eine Variable von Typ Workbook und weise ihr beim Öffnen der Mappe gleich die entsprechende Mappe zu. Achtung die Attribute gehören dann in Klammern. Bsp.:
Dim wkb As Workbook
Set wkb = Workbooks.Open(Filename:=strPfad & strMappe)
Dann kannst du die Ausgangsmappe mit "ThisWorkbook" und die geöffnete mit wkb ansprechen, ohne dir die Namen irgendwohin zu schreiben.
lg Steve

Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
11.03.2016 16:30:24
Beverly
Hi Alex,
sorry, habe keine Mailbenachrichtigung bekommen.
Es muss nicht zwischen den Blättern hin und her selektiert werden, denn in meinem Code wird korrekt auf die richtigen Blätter referenziert.
Die folgende Zeile
    With ThisWorkbook.Worksheets("Tabelle1")

beideutet, dass sich auf die Mappe mit dem Code und darin auf Tabelle1 bezogen wird - das ist das Zieltabellenblatt.
Beim Öffnen der Mappen aus dem Ordner, ist die betreffnende Mappe jeweils die aktive - das findest du in dieser Zeile
            For Each wksTab In ActiveWorkbook.Worksheets
in der mit der Schleife über alle Tabellenblätter der aktiven Mappe gelaufen wird und in der folgenden Zeile, wird sich stets auf das laufende Tabellenblatt der aktiven Mappe bezogen

With wksTab

Somit ist alles korrekt.
Ich nehme aber an, dass deine Diagramme nicht "TS" im Namen beinhalten, weshalb keine kopiert werden - deshalb solltest du den Code aus meinem vorhergehenden beitrag mal ausführen: und zwar in der Arbeitsmappe, in die kopiert werden soll.
Wenn du also mit "Name" eventuell nicht den Diagrammnamen sondern den Diagrammtitel meinst, dann musst du den Code wie folgt ändern:
            For Each wksTab In ActiveWorkbook.Worksheets
With wksTab
If .ChartObjects.Count > 0 Then
For Each chrDia In .ChartObjects
If chrDia.Chart.HasTitle Then
If InStr(chrDia.Name, "TS") > 0 Then
chrDia.Copy
ThisWorkbook.Worksheets("Tabelle1").Paste
End If
End If
Next chrDia
End If
End With
Next wksTab


Anzeige
AW: Alle Diagramme aus mehreren Workbooks sammeln
14.03.2016 09:41:36
Alex
Hi Karin,
Du hast Recht, mein Fehler! Ich habe meine Makros in einem Addin, das automatisch beim Öffnen von Excel geladen wird und von dem aus der Aufruf passiert. Habe den Aufruf also immer gemacht, wenn das leere Workbook gerade nicht aktiv war...
Jetzt passts!
Vielen Dank :-)

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige