Hallo zusammen,

meine vba Kenntnisse sind etwas beschränkt, da ich nur gelegentlich einen Code schreibe. Zurzeit soll ich eine Druckversion von Exceldaten erstellen, die ich zuvor in eine PowerPoint einfügen soll. Wahrscheinlich ist mein Code aber ziemlich umständlich, da mir auf die schnelle kein besserer Weg eingefallen ist. Aber auf jeden Fall ist der Code ziemlich langsam. Das öffnen von PowerPoint ist dabei noch nicht mal der langsame Teil, sondern das Kopieren der Texte.

Kann mal bitte jmd. über den Code schauen und mir einen Vorschlag schicken, wie es schneller gehen könnte? Das wäre super, vielen Dank.

Ich habe Office 2007. Hier der Code:

Sub ExceldatenNachPowerPoint()

Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set pptPres = pptApp.Presentations.Open("K:\Dokumente\Arbeitsgruppe_Innovationsmanagement\Excel-Dokumente\Test.pptx")
Set pptSlide = pptPres.Slides(1)
Set Kopierbereich = New DataObject

Application.CutCopyMode = False

Sheets("Projektangaben").Range("T1") = Sheets("Projektangaben").USPBox
Sheets("Projektangaben").Range("T1").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(1).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Projektangaben").Range("T4") = Sheets("Projektangaben").Zielmarkt
Sheets("Projektangaben").Range("T4").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(2).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Projektangaben").Range("T5") = Sheets("Projektangaben").Begründung
Sheets("Projektangaben").Range("T5").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(3).TextFrame.TextRange.text = Kopierbereich.GetText

Set pptSlide = pptPres.Slides(2)

Sheets("Projektangaben").Range("T6") = Sheets("Projektangaben").Dimension1
Sheets("Projektangaben").Range("T6").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(4).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Projektangaben").Range("T7") = Sheets("Projektangaben").Dimension2
Sheets("Projektangaben").Range("T7").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(6).TextFrame.TextRange.text = Kopierbereich.GetText

Set pptSlide = pptPres.Slides(3)

Sheets("Detailuntersuchung-Marktanalyse").Range("T1") = Sheets("Detailuntersuchung-Marktanalyse").Zielgruppe
Sheets("Detailuntersuchung-Marktanalyse").Range("T1").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(4).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Detailuntersuchung-Marktanalyse").Range("T2") = Sheets("Detailuntersuchung-Marktanalyse").Wachstum1
Sheets("Detailuntersuchung-Marktanalyse").Range("T2").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(7).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Detailuntersuchung-Marktanalyse").Range("T3") = Sheets("Detailuntersuchung-Marktanalyse").Wachstum2
Sheets("Detailuntersuchung-Marktanalyse").Range("T3").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(9).TextFrame.TextRange.text = Kopierbereich.GetText

Set pptSlide = pptPres.Slides(4)

Sheets("Detailuntersuchung-Marktanalyse").Range("T4") = Sheets("Detailuntersuchung-Marktanalyse").WarumErfolg
Sheets("Detailuntersuchung-Marktanalyse").Range("T4").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(2).TextFrame.TextRange.text = Kopierbereich.GetText

Sheets("Detailuntersuchung-Marktanalyse").Range("T5") = Sheets("Detailuntersuchung-Marktanalyse").Fazit
Sheets("Detailuntersuchung-Marktanalyse").Range("T5").Copy
Kopierbereich.GetFromClipboard
pptSlide.Shapes(3).TextFrame.TextRange.text = Kopierbereich.GetText

End Sub