Alle Diagramme aus mehreren Workbooks sammeln

Forumthread: 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 :-)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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?

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?

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

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

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 :-)

Beliebteste Forumthreads (12 Monate)

Alle Diagramme aus mehreren Workbooks sammeln

Forumthread: Alle Diagramme aus mehreren Workbooks sammeln

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Alle Diagramme aus mehreren Workbooks sammeln

Forumthread: Alle Diagramme aus mehreren Workbooks sammeln

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread