P
Paul Cook
Here is what I am doing:
1) Automated Excel to pull data from DB2 and created charts
2) Need to take charts from Excel and place them into a
powerpoint presentation.
If someone can point me in the right direction to get this
done it would be greatly appreciated.
Paul
I have a master powerpoint presentation that I add slides
to and format to ppLayoutFourObjects. I need to get the
charts from Excel and place them in the correct "object"
on the sheet.
Here is the code that I have: (It will create an Excel
worksheet and fill in some test data, create a chart, then
open my Powerpoint master, add slides.
Option Explicit
Dim xlApp As Object
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Public Sub main()
Dim r As Variant
Dim MyChart As String
Dim iWhereAt As Integer
Const sLookFor = " "
Call LoadExcel
Call FillData
MyChart = BuildChart
iWhereAt = InStr(1, MyChart, sLookFor) + 1
MyChart = Mid(MyChart, iWhereAt)
Call ClearClipboard
Call LoadPP
Call CopyChart(MyChart)
xlBook.Activate
xlBook.Sheets(1).Select
End Sub
Public Sub LoadPP()
Dim MyTest
Dim y As Integer
Set ppApp = New PowerPoint.Application
ppApp.Visible = msoTrue
Set ppPres = ppApp.Presentations.Open("C:\SSP\SSP
Yield Master.ppt")
Call AddTestSlide(ppApp)
For y = 2 To 6
ppApp.ActiveWindow.View.GotoSlide Index:=y
Call TitleSlide(ppApp, y)
Next
ppApp.ActiveWindow.View.GotoSlide Index:=2
End Sub
Public Sub AddTestSlide(ppCurApp As PowerPoint.Application)
Dim sldNewSlide As PowerPoint.Slide
Dim shpCurrShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long
Dim x As Integer
With ppCurApp.ActivePresentation
With .PageSetup
lngSlideHeight = .SlideHeight
lngSlideWidth = .SlideWidth
End With
' Add new slide to end of presentation
For x = 1 To 5
Set sldNewSlide = .Slides.Add(.Slides.Count +
1, ppLayoutFourObjects)
Next
End With
End Sub
Public Sub TitleSlide(ppCurApp As PowerPoint.Application,
iSlide As Integer)
ppCurApp.ActiveWindow.Selection.SlideRange.Shapes
("Rectangle 2").Select
ppCurApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRa
nge.Select
ppCurApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRa
nge.Characters(Start:=1, Length:=0).Select
With ppCurApp.ActiveWindow.Selection.TextRange
If iSlide >= 2 And iSlide <= 3 Then
.Text = "Single Slider Yields"
ElseIf iSlide >= 4 And iSlide <= 6 Then
.Text = "Yield Summary"
End If
With .Font
.Name = "Arial"
.NameOther = "Arial"
.Size = 34
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoTrue
.Color.SchemeColor = ppTitle
End With
End With
End Sub
Public Sub CopyChart(sCurrChartName As String)
ActiveSheet.ChartObjects(sCurrChartName).Activate
ActiveChart.ChartArea.Select
xlBook.Worksheets(1).ChartObjects(1).CopyPicture
ppPres.Slides(2).Shapes.PasteSpecial (ppPasteDefault)
'ActiveChart.ChartArea.Copy
End Sub
Public Sub ClearClipboard()
Clipboard.Clear
End Sub
Public Sub FillData()
Sheets(1).Cells(2, 2).Value = "A"
Sheets(1).Cells(3, 2).Value = "B"
Sheets(1).Cells(4, 2).Value = "C"
Sheets(1).Cells(5, 2).Value = "D"
Sheets(1).Cells(6, 2).Value = "E"
Sheets(1).Cells(7, 2).Value = "F"
Sheets(1).Cells(8, 2).Value = "G"
Sheets(1).Cells(2, 3).Value = 15
Sheets(1).Cells(3, 3).Value = 5
Sheets(1).Cells(4, 3).Value = 8
Sheets(1).Cells(5, 3).Value = 2
Sheets(1).Cells(6, 3).Value = 17
Sheets(1).Cells(7, 3).Value = 3
Sheets(1).Cells(8, 3).Value = 10
End Sub
Public Sub LoadExcel()
Dim iSheetsInWB As Integer
Dim iSheetsToAdd As Integer
Dim iAddIter As Integer
Set xlApp = CreateObject("excel.application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
iSheetsInWB = xlBook.Sheets.Count
If iSheetsInWB < 1 Then
iSheetsToAdd = 3 - iSheetsInWB
For iAddIter = 1 To iSheetsToAdd
xlBook.Sheets.Add After:=xlBook.Worksheets
(xlBook.Worksheets.Count)
Next
End If
xlBook.Sheets(1).Select
Set xlSheet = xlBook.Sheets(iSheetsInWB)
End Sub
Public Function BuildChart() As String
Dim sChartName As String
Range("B2:C8").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets
("Sheet1").Range("B2:C8"), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject,
Name:="Sheet1"
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.ChartArea.Select
sChartName = ActiveChart.Name
BuildChart = sChartName
End Function
1) Automated Excel to pull data from DB2 and created charts
2) Need to take charts from Excel and place them into a
powerpoint presentation.
If someone can point me in the right direction to get this
done it would be greatly appreciated.
Paul
I have a master powerpoint presentation that I add slides
to and format to ppLayoutFourObjects. I need to get the
charts from Excel and place them in the correct "object"
on the sheet.
Here is the code that I have: (It will create an Excel
worksheet and fill in some test data, create a chart, then
open my Powerpoint master, add slides.
Option Explicit
Dim xlApp As Object
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Public Sub main()
Dim r As Variant
Dim MyChart As String
Dim iWhereAt As Integer
Const sLookFor = " "
Call LoadExcel
Call FillData
MyChart = BuildChart
iWhereAt = InStr(1, MyChart, sLookFor) + 1
MyChart = Mid(MyChart, iWhereAt)
Call ClearClipboard
Call LoadPP
Call CopyChart(MyChart)
xlBook.Activate
xlBook.Sheets(1).Select
End Sub
Public Sub LoadPP()
Dim MyTest
Dim y As Integer
Set ppApp = New PowerPoint.Application
ppApp.Visible = msoTrue
Set ppPres = ppApp.Presentations.Open("C:\SSP\SSP
Yield Master.ppt")
Call AddTestSlide(ppApp)
For y = 2 To 6
ppApp.ActiveWindow.View.GotoSlide Index:=y
Call TitleSlide(ppApp, y)
Next
ppApp.ActiveWindow.View.GotoSlide Index:=2
End Sub
Public Sub AddTestSlide(ppCurApp As PowerPoint.Application)
Dim sldNewSlide As PowerPoint.Slide
Dim shpCurrShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long
Dim x As Integer
With ppCurApp.ActivePresentation
With .PageSetup
lngSlideHeight = .SlideHeight
lngSlideWidth = .SlideWidth
End With
' Add new slide to end of presentation
For x = 1 To 5
Set sldNewSlide = .Slides.Add(.Slides.Count +
1, ppLayoutFourObjects)
Next
End With
End Sub
Public Sub TitleSlide(ppCurApp As PowerPoint.Application,
iSlide As Integer)
ppCurApp.ActiveWindow.Selection.SlideRange.Shapes
("Rectangle 2").Select
ppCurApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRa
nge.Select
ppCurApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRa
nge.Characters(Start:=1, Length:=0).Select
With ppCurApp.ActiveWindow.Selection.TextRange
If iSlide >= 2 And iSlide <= 3 Then
.Text = "Single Slider Yields"
ElseIf iSlide >= 4 And iSlide <= 6 Then
.Text = "Yield Summary"
End If
With .Font
.Name = "Arial"
.NameOther = "Arial"
.Size = 34
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoTrue
.Color.SchemeColor = ppTitle
End With
End With
End Sub
Public Sub CopyChart(sCurrChartName As String)
ActiveSheet.ChartObjects(sCurrChartName).Activate
ActiveChart.ChartArea.Select
xlBook.Worksheets(1).ChartObjects(1).CopyPicture
ppPres.Slides(2).Shapes.PasteSpecial (ppPasteDefault)
'ActiveChart.ChartArea.Copy
End Sub
Public Sub ClearClipboard()
Clipboard.Clear
End Sub
Public Sub FillData()
Sheets(1).Cells(2, 2).Value = "A"
Sheets(1).Cells(3, 2).Value = "B"
Sheets(1).Cells(4, 2).Value = "C"
Sheets(1).Cells(5, 2).Value = "D"
Sheets(1).Cells(6, 2).Value = "E"
Sheets(1).Cells(7, 2).Value = "F"
Sheets(1).Cells(8, 2).Value = "G"
Sheets(1).Cells(2, 3).Value = 15
Sheets(1).Cells(3, 3).Value = 5
Sheets(1).Cells(4, 3).Value = 8
Sheets(1).Cells(5, 3).Value = 2
Sheets(1).Cells(6, 3).Value = 17
Sheets(1).Cells(7, 3).Value = 3
Sheets(1).Cells(8, 3).Value = 10
End Sub
Public Sub LoadExcel()
Dim iSheetsInWB As Integer
Dim iSheetsToAdd As Integer
Dim iAddIter As Integer
Set xlApp = CreateObject("excel.application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
iSheetsInWB = xlBook.Sheets.Count
If iSheetsInWB < 1 Then
iSheetsToAdd = 3 - iSheetsInWB
For iAddIter = 1 To iSheetsToAdd
xlBook.Sheets.Add After:=xlBook.Worksheets
(xlBook.Worksheets.Count)
Next
End If
xlBook.Sheets(1).Select
Set xlSheet = xlBook.Sheets(iSheetsInWB)
End Sub
Public Function BuildChart() As String
Dim sChartName As String
Range("B2:C8").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets
("Sheet1").Range("B2:C8"), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject,
Name:="Sheet1"
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.ChartArea.Select
sChartName = ActiveChart.Name
BuildChart = sChartName
End Function