VBA - Grafik von Excel nach Powerpoint

[Danyelz]

Guten Tag 

Ich versuche einen Graphen von Excel via VBA nach Powerpoint zu übertragen und nutze folgenden Code:

Sub ChartObjectsNachPowerpoint()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue)
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Chart.ChartArea.Copy
i = i + 1
Set pptslide = pptPres.Slides.Add(i, 12) '12 = ppLayoutBlank
Set shp = pptslide.Shapes.Paste
shp.Top = 0
shp.Left = 0
shp.Width = 400
shp.Height = 400
Next
pptApp.Visible = True
End Sub



Das funktioniert auch super, jedoch möchte ich die Grafik nicht einfach kopieren sondern ich möchte "Ursprüngliche Formatierung beibehalten und Arbeitsmappe einbetten" nutzen, was über Rechtsklick+U funktioniert.
Weiß jemand wie ich den Code anpassen müsste?

VG

[Flotter Feger]

Hallo,

so ...

PHP-Code:

Sub DiagrammInPP()
Dim ppApp As Object
Dim FolienNr As Integer
Dim Diagramm As Object

'Diagramm kopieren'
ActiveSheet.ChartObjects("Diagramm 1").Copy

'PP-Object erstellen'
Set ppApp = CreateObject("powerpoint.Application")

With ppApp
           
    'Aktuelle Foliennummer auslesen und in Variable speichern'
    FolienNr = .ActivePresentation.Windows(1).View.Slide.SlideNumber
   
    'Zeiger auf eingefügte Bilddatei in aktuelle Folie setzen'
    Set Diagramm = .ActivePresentation.Slides(FolienNr).Shapes.PasteSpecial(0) '(ppPasteDefault)'
           
    'Diagramm auswählen und formatieren'
    With Diagramm
        'Ansichtsverhältnis entsperren'
        .LockAspectRatio = msoTrue
        'Oberer Rand'
        .Top = 50
        'Linker Rand'
        .Left = 50
        'Eingefügte Tabelle skalieren'
        .Width = 500
        '.Height = 382.5'
        End With
    End With
   
'Zwischenablage leeren'
Application.CutCopyMode = False
'PP-Object löschen'
Set ppApp = Nothing
End Sub 


[Danyelz]

Danke für die Antwort, aber das habe ich nicht gesucht.

Es geht mir darum, die Grafik zu kopieren und einzubetten, damit sich die Grafik nicht automatisch updated.

[Flotter Feger]

Hallo,

vielleicht solltest du dir erst mal überlegen, was du jetzt genau willst.
In deinem ersten Post schreibst du

ich möchte "Ursprüngliche Formatierung beibehalten und Arbeitsmappe einbetten"

Genau das macht der Code, den ich dir geschrieben habe.

Jetzt möchtest du, dass sich das 'Picture' nicht anpasst, bei Änderungen im Original.

Das wäre dann ...
Activesheet.ChartObjects("Diagramm 1").CopyPicture xlScreen, XlBitmap

und ein einfaches
ppt.Shapes.Paste

Aber das hattest du ja im Prinzip schon.

Sabina