Diagramm kopieren

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread