Thema Datum  Von Nutzer Rating
Antwort
Rot PowerPoint aus Excel automatisiert erstellen
 16.07.2014 09:23:18 Sendor
NotSolved

Ansicht des Beitrags:
Von:
Sendor		 Datum:
16.07.2014 09:23:18		 Views:
1367		 Rating:
     
Antwort:
  Ja
Thema:
PowerPoint aus Excel automatisiert erstellen

In meinem Excel-Dokument (mehrere Sheets) möchte ich automatisiert bestimmte Inhalte nach PowerPoint kopieren.

Grundsätzlich erledigt das nachstehende Script die Aufgabe auch. Leider bekomme ich es nicht hin, dass Script so anzupassen, dass es Daten mehrere Sheets nach PowerPoint (pro Sheet ein PowerPoint-Slide) kopiert. So wird aktuell nur "Sheet1" bzw. der Zellbereich "A1:G31" von "Sheet1" nach PowerPoint kopiert.

Schön wäre dann auch noch, wenn ich den zu kopierenden Zellbereich von Sheet zu Sheet ändern (neu definieren) könnte.

Der grönende Abschluß wäre eine Art Konfigurator (Add-In), über den ich (z.B. via Radiobutton) die einzelnen Sheets an- und abwählen kann.

Hat jemand hierzu ein Script oder kann entsprechend unterstützen. In VBA kenn ich mich leider überhaupt nicht aus.

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Sub Copy_Paste_to_PowerPoint()
 
 'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
        
    Dim SheetName As String
    Dim TestRange As Range
    Dim TestSheet As Worksheet
    Dim TestChart As ChartObject
      
    Dim PasteChart As Boolean
    Dim PasteChartLink As Boolean
    Dim ChartNumber As Long
      
    Dim PasteRange As Boolean
    Dim RangePasteType As String
    Dim RangeName As String
    Dim AddSlidesToEnd As Boolean
      
     'Parameters
      
     'SheetName           - name of sheet in Excel that contains the range or chart to copy
      
     'PasteChart          -If True then routine will  copy and paste a chart
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link
     'ChartNumber         -Chart Object Number
     '
     'PasteRange          - If True then Routine will copy and Paste a range
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange"
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide.
      
     'use active sheet. This can be a direct sheet name
    'SheetName = ActiveSheet.Name
    SheetName = "Sheet1"
      
     'Setting PasteRange to True means that Chart Option will not be used
    PasteRange = True
    RangeName = "A1:G31"
    RangePasteType = "HTML"
    RangeLink = True
      
    PasteChart = True
    PasteChartLink = True
    ChartNumber = 1
      
    AddSlidesToEnd = True
      
      
     'Error testing
    On Error Resume Next
    Set TestSheet = Sheets(SheetName)
    Set TestRange = Sheets(SheetName).Range(RangeName)
    Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
    On Error GoTo 0
      
    If TestSheet Is Nothing Then
        MsgBox "Sheet " & SheetName & " existiert nicht. Ergebnispräsentation wird nicht erzeugt!", vbCritical
        Exit Sub
    End If
      
    If PasteRange And TestRange Is Nothing Then
        MsgBox "Range " & RangeName & " existiert nicht. Ergebnispräsentation wird nicht erzeugt!", vbCritical
        Exit Sub
    End If
      
    If PasteRange = False And PasteChart And TestChart Is Nothing Then
        MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical
        Exit Sub
    End If
      
      
     'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
      
     'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
     'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
      
     'Make the instance visible
    ppApp.Visible = True
      
     'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
    Else
        If AddSlidesToEnd Then
             'Appends slides to end of presentation and makes last slide active
            ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
            ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
            Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
        Else
             'Sets current slide to active slide
            Set ppSlide = ppApp.ActiveWindow.View.Slide
        End If
    End If
      
     'Options for Copy & Paste Ranges and Charts
    If PasteRange = True Then
         'Options for Copy & Paste Ranges
        If RangePasteType = "Picture" Then
             'Paste Range as Picture
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
        Else
             'Paste Range as HTML
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
        End If
    Else
         'Options for Copy and Paste Charts
        Worksheets(SheetName).Activate
        ActiveSheet.ChartObjects(ChartNumber).Select
        If PasteChartLink = True Then
             'Copy & Paste Chart Linked
            ActiveChart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(link:=True).Select
        Else
             'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ppSlide.Shapes.Paste.Select
        End If
    End If
      
     'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
      
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing
 
  
End Sub

Vielen Dank für die Unterstützung

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:
WYSIWYG-Editor, ctl00_Content_editor1



  • 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 PowerPoint aus Excel automatisiert erstellen
 16.07.2014 09:23:18 Sendor
NotSolved