Diagramm kopieren

Bild

Betrifft: Diagramm kopieren
von: Stefan
Geschrieben am: 14.09.2015 13:31:31

Hallo,
ich bitte um Eure Unterstützung. Ich möchte aus Sheet "Output" alle 5 Diagramme nach Sheet In.1!A1 kopieren. Ich benötige lediglich ein Bild oder Screenshot, keinen interaktiven, sich updatenden Clon. Wie steuere ich in VBA die Diagramme an. Google kennt zwar Makros, sich den Diagrammnamen anzeigen zu lassen. Allerdings muss nur das Makro den Diagrammnamen kennen, nicht ich via Message Box.
Wie müsste ich es programmieren, wenn jedes eingefügte Bild auch noch 4 Zeilen hoch und 4 Spalten breit sein soll (Excel Standardmaße 17 hoch und 80 breit)?
So stelle ich mir das (ohne Umsetzung der Wunschmaße) vor. "Diagramm1" ist ein Dummy, der hie alle Diagramme der Arbeitsmappe "Output" umfassen soll. Ist ein Konglomerat aus Google und Makrorekorder.

Sub DiagrammAlsBild()
    Sheets("Output").Select
    ActiveSheet.ChartObjects("Diagramm1").CopyPicture
    Sheets("IN.1").Select
    Range("A1").Select
    Sheets("IN.1").Paste
End Sub
Danke Stefan

Bild

Betrifft: AW: Diagramm kopieren
von: EtoPHG
Geschrieben am: 14.09.2015 14:12:07
Hallo Stefan,
Probier mal diesen Code in einem Modul:

Option Explicit
Sub CopyDiagramme()
    Dim diaX
    Dim lRow As Long
    Dim wsQuelle As Worksheet
    Dim wsZiel As Worksheet
    
    Set wsQuelle = ThisWorkbook.Worksheets("Output")
    Set wsZiel = ThisWorkbook.Worksheets("In.1")
    wsZiel.Pictures.Delete
    wsZiel.Activate
    lRow = 1
    For Each diaX In wsQuelle.ChartObjects
        diaX.Chart.CopyPicture
        wsZiel.Paste
        With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Left = wsZiel.Cells(lRow, 1).Left
            .Top = wsZiel.Cells(lRow, 1).Top
            .Width = wsZiel.Columns(5).Left - 1
            .Height = wsZiel.Rows(5).Top - 1
            lRow = lRow + 4
        End With
    Next diaX
End Sub
Gruess Hansueli

Bild

Betrifft: AW: Diagramm kopieren
von: Stefan
Geschrieben am: 14.09.2015 15:06:08
Hallo Hansueli,
Danke. Nicht das ich alles verstanden hätte, aber es funktioniert schon ganz prächtig. Ich habe auch begriffen, wie man die Bilder größer und kleiner machen kann. Wo ändert man die Position in der Tabelle. Ich hätte es gerne in Zelle In.1!T242. A1 war nur ein Dummy. Das habe ich noch nicht raus.
Danke Stefan

Bild

Betrifft: Bitte erklären... was mit Dummy gemeint ist
von: EtoPHG
Geschrieben am: 14.09.2015 15:21:24
Stefan,
Ich weiss nicht was du mit Dummy meinst.
Was willst du genau machen, was funktioniert, was nicht?
Kannst du eine Beispielmappe hochladen?
Gruess Hansueli

Bild

Betrifft: AW: Bitte erklären... was mit Dummy gemeint ist
von: EtoPHG
Geschrieben am: 14.09.2015 15:49:38




Bild

Betrifft: AW: Bitte erklären... was mit Dummy gemeint ist
von: Stefan
Geschrieben am: 14.09.2015 16:55:57
Hallo,
File Upload lässt mein Administrator leider nicht zu.
Kann ich selber: Die Bilder waren zu klein. Wie man sie vergrößert, auch ohne dass sie überlappen, bekomme ich hin.
Kann ich nicht selber: Die Bilder sind am Anfang der Tabelle (A1). Was muss ich tuen, damit ich sie eher mittig in der Tabelle positioniere, z.B. die linke obere Ecke des 1. Bildes fäng in In.1!T242 an. Alle anderen Bilder werden darunter aufgelistet. Ich kann die Zielposition noch nicht genau angeben, da die Tabelle noch nicht final steht. Daher muss ich wissen, welche Trigger ich ansteuere, das die Position der Bilder genau an der gewünschten Stelle steht.
Danke
Stefan

Bild

Betrifft: AW: Diagramm kopieren
von: Beverly
Geschrieben am: 14.09.2015 15:04:47
Hi Stefan,
sollen sie tatsächlich alle nach A1 kopiert werden oder eher alle untereinander?

Sub DiasCopy()
    Dim picDia As Picture
    Dim chrDia As ChartObject
    Dim lngZeile As Long
    lngZeile = 1
    For Each chrDia In Worksheets("Output").ChartObjects
        chrDia.Copy
        Set picDia = Worksheets("In.1").Pictures.Paste
        With picDia
            .ShapeRange.LockAspectRatio = msoFalse
            .Top = Rows(lngZeile).Top
            .Left = Range("A1").Left
            .Height = Worksheets("In.1").Rows(lngZeile & ":" & lngZeile + 3).Height
            .Width = Worksheets("In.1").Columns("A:D").Width
        End With
        lngZeile = lngZeile + 4
    Next chrDia
End Sub



Bild

Betrifft: AW: Diagramm kopieren
von: Stefan
Geschrieben am: 14.09.2015 17:17:29
Hallo,
Falls der Text jetzt 2x erscheint, sorry. Meiner erster Versuch ist im Nirvana...
File Upload gestattet mein Administrator nicht.
Mir ist unklar, was ich bei den Makros von Hans und Karin tun muss, damit die linke obere Ecke der Bilder nicht in Zelle A1 landet, sondern in z.B. T242. Das finale Layout liegt noch nicht vor, die Position kann sich daher noch aendern. Alle Bilder sollen untereinander gelistet sein.
Danke
Stefan

Bild

Betrifft: AW: Diagramm kopieren
von: Stefan
Geschrieben am: 14.09.2015 17:33:00
Hallo,
irgendwas mache ich falsch, die Antworten gehen nicht online... Fileupload laesst mein Administrator nicht zu.
Ich moechte gerne die Bilder untereinander darstellen. Die linke obere Ecke soll in Zelle T242 landen. Also nicht in A1. Da das Layout noch nicht final ist, kann es auch eine beliebige andere Zelle sein.
Danke
Stefan

Bild

Betrifft: AW: Diagramm kopieren
von: Beverly
Geschrieben am: 14.09.2015 19:47:12
Hi Stefan,
du musst nur die Zeilennummer und die Spalten entsprechend anpassen:

Sub DiasCopy()
    Dim picDia As Picture
    Dim chrDia As ChartObject
    Dim lngZeile As Long
    lngZeile = 242
    For Each chrDia In Worksheets("Output").ChartObjects
        chrDia.Copy
        Set picDia = Worksheets("In.1").Pictures.Paste
        With picDia
            .ShapeRange.LockAspectRatio = msoFalse
            .Top = Rows(lngZeile).Top
            .Left = Range("T242").Left   ' oder Columns("T").Left
            .Height = Worksheets("In.1").Rows(lngZeile & ":" & lngZeile + 3).Height
            .Width = Worksheets("In.1").Columns("T:W").Width
        End With
        lngZeile = lngZeile + 4
    Next chrDia
End Sub



Bild

Betrifft: AW: Diagramm kopieren
von: Stefan
Geschrieben am: 15.09.2015 09:01:39
Hallo Karin,
lngZeile = 242 hatte ich übersehen. Da war noch = 1. Danke Stefan

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Diagramm kopieren"