Thema Datum  Von Nutzer Rating
Antwort
Rot Probleme beim Einfügen von Grafiken in PPT
 22.10.2010 23:13:25 Stefan Rieser
NotSolved

Ansicht des Beitrags:
Von:
Stefan Rieser		 Datum:
22.10.2010 23:13:25		 Views:
1749		 Rating:
     
Antwort:
  Ja
Thema:
Probleme beim Einfügen von Grafiken in PPT
Hallo,

ich habe mehrere Bilder in einer Arbeitsmappe auf verschiedenen Sheets. Ich möchte diese alllerdings alle in eine bestehende Powerpoint-Presentation einfügen. Das ganze soll aber erst nach dem Sheet 6 starten. Ich habe irgendwie schon alles probiert. Mein Makro importiert aber nichts. Wäre für Hilfe sehr dankbar. Vielen Dank im Voraus.


Sub PowerPointErzeugen_Click()

Dim Grafik As Shape
Dim pp As PowerPoint.Application
Dim PP_Datei As PowerPoint.Presentation
Dim PP_Folie As PowerPoint.Slide
'Dim Path As String
Dim i As Integer

On Error GoTo Zuruecksetzen

'Worksheets("Projektplan").Select

Set pp = CreateObject("Powerpoint.Application")
Path = ActiveWorkbook.Path

With pp
.Visible = True
' .Presentations.Add
.Presentations.Open Filename:="S:Malki\test.ppt"
End With

Set PP_Datei = pp.ActivePresentation
For i = 1 To Sheets.Count
For Each Grafik In Sheets(i).Shapes
'neue Folie einfügen
If Grafik.Type = msoPicture Then
'pp.ActivePresentation.Slides.Add 1, ppLayoutBlank
Set PP_Folie = PP_Datei.Slides(1)
'kopieren
Sheets(i).Grafik.CopyPicture
PP_Folie.Shapes.Paste
Else: GoTo neuesblatt
End If
'einfügen

PP_Folie.Select
'Bereich einfügen und OLE Verknüpfung herstellen = Link
With pp.ActiveWindow
.ViewType = ppViewSlide
'.View.PasteSpecial DataType:=ppPasteOLEObject, link:=msoTrue
End With

With PP_Folie.Shapes.Range
'Oberer Rand 1 cm unter Standardtitel
.Top = 150
'Linker Rand 1.5 cm von linkem Folienrand
.Left = 35
'Eingefügte Tabelle auf Links und rechts 1,5 cm Rand skalieren
.Width = 650
'Bei Bedarf Höhe noch einstellen
'Hier ist jedoch zu beachten, dass das Object skaliert wird !!!
'Die Breite verändert sich dann
'.Height = 240
End With


Next Grafik
neuesblatt:

Next i


Set PP_Folie = Nothing
Set PP_Datei = Nothing
Set pp = Nothing

Exit Sub

Zuruecksetzen:
Set PP_Folie = Nothing
Set PP_Datei = Nothing
Set pp = Nothing
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Probleme beim Einfügen von Grafiken in PPT
 22.10.2010 23:13:25 Stefan Rieser
NotSolved