genes

¦^´_ 1# xperia0603
½Ð°Ñ¦Ò¥H¤Uvba

1. Sub CreatePowerPoint()
   
2. 
   
3. 'Add a reference to the Microsoft PowerPoint Library by:
   
4.     '1. Go to Tools in the VBA menu
   
5.     '2. Click on Reference
   
6.     '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
   
7. 
   
8.     'First we declare the variables we will be using
   
9.         Dim newPowerPoint As PowerPoint.Application
   
10.         Dim activeSlide As PowerPoint.Slide
    
11.         Dim cht As Excel.ChartObject
    
12.      
    
13.      'Look for existing instance
    
14.         On Error Resume Next
    
15.         Set newPowerPoint = GetObject(, "PowerPoint.Application")
    
16.         On Error GoTo 0
    
17.      
    
18.     'Let's create a new PowerPoint
    
19.         If newPowerPoint Is Nothing Then
    
20.             Set newPowerPoint = New PowerPoint.Application
    
21.         End If
    
22.     'Make a presentation in PowerPoint
    
23.         If newPowerPoint.Presentations.Count = 0 Then
    
24.             newPowerPoint.Presentations.Add
    
25.         End If
    
26.      
    
27.     'Show the PowerPoint
    
28.         newPowerPoint.Visible = True
    
29.    
    
30.     'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    
31.         For Each cht In ActiveSheet.ChartObjects
    
32.         
    
33.         'Add a new slide where we will paste the chart
    
34.             newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
    
35.             newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
    
36.             Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
    
37.                
    
38.         'Copy the chart and paste it into the PowerPoint as a Metafile Picture
    
39.             cht.Select
    
40.             ActiveChart.ChartArea.Copy
    
41.             activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    
42.    
    
43.         'Set the title of the slide the same as the title of the chart
    
44.             activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    
45.             
    
46.         'Adjust the positioning of the Chart on Powerpoint Slide
    
47.             newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
    
48.             newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125
    
49.         
    
50.             activeSlide.Shapes(2).Width = 200
    
51.             activeSlide.Shapes(2).Left = 505
    
52.             
    
53.         Next
    
54.      
    
55.     AppActivate ("Microsoft PowerPoint")
    
56.     Set activeSlide = Nothing
    
57.     Set newPowerPoint = Nothing
    
58.      
    
59. End Sub

½Æ»s¥N½X

genes

¦^´_ 4# xperia0603


    ½Ðªþ¤WÀÉ®×