I'm working witht he following code:
Sub AddTrendLinesBoth()
Dim myCht As ChartObject
Dim oTren As Trendline
Dim oWb As Workbook
Dim oWS As Worksheet
Set oWb = ThisWorkbook
Set oWS = oWb.Sheets("Summary")
Set myCht = oWS.ChartObjects("Chart 1")
On Error GoTo GetOut
With myCht.Chart
.SeriesCollection(1).Trendlines.Add
.SeriesCollection(2).Trendlines.Add
End With
Set oTren = myCht.SeriesCollection(1).Trendlines(1)
With oTren.Format.Line
.Visible = msoTrue
.Weight = 3
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
End With
Set oTren = myCht.SeriesCollection(2).Trendlines(1)
With oTren.Format.Line
.Visible = msoTrue
.Weight = 3
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
GetOut:
End Sub
On each instance of set oTren = the code errors out on establishing the variable. What am I missing to adequately establish that line?
The reason I'm using with statements as set variables, is because using ActiveChart and ActiveSheet was throwing method errors with older versions of Excel.
The problem is that myCht is a ChartObject object rather than a Chart object. You thus need to go through the chart object's chart method to get to the elements of the chart, such as trendlines associated to series:
Set oTren = myCht.Chart.SeriesCollection(1).Trendlines(1)
Related
For the purpose of sales department I have a query that tracks previous price points and calculates margins. I would like to export this info to Excel to create a combo chart to make the information more visual. I've found some sample code on another site, but it doesn't quite do everything I need. I've used the macro recorder to come up with my desire code, but it uses different methods than my sample code. Can anyone help me to combine the following codes to come up with Combo Charts via VBA?
'sample code below
Private Sub Command201_Click()
Option Compare Database
Private Const conQuery = "qryTopTenProducts"
Private Const conSheetName = "Top 10 Products"
Private Sub Command201_Click()
Dim rst As ADODB.Recordset
' Excel object variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlChart As Excel.Chart
Dim i As Integer
On Error GoTo HandleErr
' Create Excel Application object.
Set xlApp = New Excel.Application
' Create a new workbook.
Set xlBook = xlApp.Workbooks.Add
' Get rid of all but one worksheet.
xlApp.DisplayAlerts = False
For i = xlBook.Worksheets.Count To 2 Step -1
xlBook.Worksheets(i).Delete
Next i
xlApp.DisplayAlerts = True
' Capture reference to first worksheet.
Set xlSheet = xlBook.ActiveSheet
' Change the worksheet name.
xlSheet.Name = conSheetName
' Create recordset.
Set rst = New ADODB.Recordset
rst.OPEN _
Source:=conQuery, _
ActiveConnection:=CurrentProject.Connection
With xlSheet
' Copy field names to Excel.
' Bold the column headings.
With .Cells(1, 1)
.Value = rst.Fields(0).Name
.Font.Bold = True
End With
With .Cells(1, 2)
.Value = rst.Fields(1).Name
.Font.Bold = True
End With
' Copy all the data from the recordset
' into the spreadsheet.
.Range("A2").CopyFromRecordset rst
' Format the data.
.Columns(1).AutoFit
With .Columns(2)
.NumberFormat = "#,##0"
.AutoFit
End With
End With
' Create the chart.
Set xlChart = xlApp.Charts.Add
With xlChart
.ChartType = xlComboColumnClusteredLine
.SetSourceData xlSheet.Cells(1, 1).CurrentRegion
.PlotBy = xlColumns
.Location _
Where:=xlLocationAsObject, _
Name:=conSheetName
End With
' Setting the location loses the reference, so you
' must retrieve a new reference to the chart.
With xlBook.ActiveChart
.HasTitle = True
.HasLegend = False
With .ChartTitle
.Characters.Text = conSheetName & " Chart"
.Font.Size = 16
.Shadow = True
.Border.LineStyle = xlSolid
End With
With .ChartGroups(1)
.GapWidth = 20
.VaryByCategories = True
End With
.Axes(xlCategory).TickLabels.Font.Size = 8
.Axes(xlCategoryScale).TickLabels.Font.Size = 8
End With
' Display the Excel chart.
xlApp.Visible = True
ExitHere:
On Error Resume Next
' Clean up.
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
HandleErr:
MsgBox Err & ": " & Err.Description, , "Error in CreateExcelChart"
Resume ExitHere
End Sub
'macro recorded code
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("'PART TARGET'!$A$1:$E$5")
ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(1).AxisGroup = 1
ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(2).AxisGroup = 1
ActiveChart.FullSeriesCollection(3).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(3).AxisGroup = 1
ActiveChart.FullSeriesCollection(4).ChartType = xlLine
ActiveChart.FullSeriesCollection(4).AxisGroup = 1
ActiveChart.FullSeriesCollection(5).ChartType = xlLine
ActiveChart.FullSeriesCollection(5).AxisGroup = 1
ActiveChart.FullSeriesCollection(4).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(4).AxisGroup = 2
ActiveChart.FullSeriesCollection(3).ChartType = xlLine
The problem breaks into two parts. Exporting the data to Excel and then having Excel create a Combo Chart. If you are creating the Excel file you can use Access's Export Data Wizard to create a saved export of almost anything in access. Then its a simple call to:
DoCmd.RunSavedImportExport "Export-MyTabletoExcel"
If you already have an Excel File with a macro for creating the chart from where the data goes then you can create the chart by simply calling the macro from Access
runExcelMacro "C:\Users\bubblegum\Desktop\test2.xlsm", "CreateComboChart"
Public Sub runExcelMacro(wkbookPath, macroName)
'adapted from https://access-excel.tips/run-excel-macro-from-access-vba/
Dim XL As Object
Set XL = CreateObject("Excel.Application")
With XL
.Visible = False
.displayalerts = False
.Workbooks.Open wkbookPath
.Run macroName
.ActiveWorkbook.Close (True)
.Quit
End With
Set XL = Nothing
End Sub
But if you have to create the Excel file it will not have a Macro yet so it is best to create that macro in Excel then translate it to Access vba:
Sub CreateComboChart()
' CreateComboChart Macro
Range("B1:D7").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("Table4!$B$1:$D$7")
ActiveChart.FullSeriesCollection(1).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(1).AxisGroup = 1
ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
ActiveChart.FullSeriesCollection(2).AxisGroup = 1
ActiveChart.FullSeriesCollection(3).ChartType = xlLine
ActiveChart.FullSeriesCollection(3).AxisGroup = 1
End Sub
became:
Public Sub CreateComboChartinExcel()
'Required: Tools > Refences: Add reference to Microsoft Excel Object Library
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlChart As Excel.Chart
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Users\bubblegum\Desktop\test.xlsm")
Set xlSheet = xlBook.ActiveSheet
xlSheet.Range("B1:D7").Select
xlSheet.Shapes.AddChart2(201, xlColumnClustered).Select
Set xlChart = xlBook.ActiveChart
xlChart.SetSourceData Source:=xlSheet.Range("B1:D7")
xlChart.FullSeriesCollection(1).ChartType = xlColumnClustered
xlChart.FullSeriesCollection(1).AxisGroup = 1
xlChart.FullSeriesCollection(2).ChartType = xlColumnClustered
xlChart.FullSeriesCollection(2).AxisGroup = 1
xlChart.FullSeriesCollection(3).ChartType = xlLine
xlChart.FullSeriesCollection(3).AxisGroup = 1
xlBook.Save 'surprisingly important
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Finally, the Access Export Wizard neither lets you append the exported data to the Excel file or lets you see the VBA. So if you want to paste to an Excel file you have to either use Docmd.TransferSpreadsheet or loop through the Access tables and copy and paste to excel. I show Docmd:
Public Sub TransferTable()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "myTable", "C:\Users\bubblegum\Desktop\test.xlsx"
End Sub
I want to loop though only a specific set of charts in one sheet and then apply to those a set of formating (title font size, title position, axis size, grid lines formating etc.)
The problem ist that there are already 66 charts on that sheet that were manually created (1 to 66). I will now add more charts but automatically generated, and only for those ones I would like to apply the formating needed.
For now I managed to create the charts and apply the formating separately. But in order to make it more fluid I would require a loop that I have not figured out yet. My idea was/is to count all Charts on the sheet and then do something like "If cnt > 66 Then "put here the code starting from the cht.Activate line".
My problem is counting all the charts. I am guessing using something like
with For -> For i to .CharObjects(i). But maybe you can suggest a different way.
Public Sub TEST()
Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range
Dim cht As ChartObject, cht1 As ChartObject, cht2 As ChartObject, cht3 As ChartObject
Dim LastRow As Long
Dim wsG As Worksheet: Set wsG = ThisWorkbook.Worksheets("Charts")
Dim wsS As Worksheet: Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
LastRow = wsS.Cells(wsS.Rows.count, "A").End(xlUp).Row
Set rng1 = wsS.Range("A4:B" & LastRow)
Set rng2 = wsS.Range("H4:I" & LastRow)
Set rng3 = wsS.Range("O4:P" & LastRow)
Set cht1 = wsG.ChartObjects.Add(Range("A595").Left, Range("A595").Top, Width:=518.5, Height:=296.7)
Set cht2 = wsG.ChartObjects.Add(Range("M595").Left, Range("M595").Top, Width:=518.5, Height:=296.7)
Set cht3 = wsG.ChartObjects.Add(Range("Y595").Left, Range("Y595").Top, Width:=518.5, Height:=296.7)
cht1.Chart.SetSourceData Source:=rng1
cht1.Chart.ChartType = xlXYScatter
cht1.ShapeRange.LockAspectRatio = msoTrue
cht1.Activate
With ActiveChart
.FullSeriesCollection(1).Name = "=""NAME 1"""
.ChartTitle.Text = "TITLE 1"
End With
cht2.Chart.SetSourceData Source:=rng2
cht2.Chart.ChartType = xlXYScatter
cht2.ShapeRange.LockAspectRatio = msoTrue
cht2.Activate
With ActiveChart
.FullSeriesCollection(1).Name = "=""NAME 2"""
.ChartTitle.Text = "TITLE 2"
End With
cht3.Chart.SetSourceData Source:=rng3
cht3.Chart.ChartType = xlXYScatter
cht3.ShapeRange.LockAspectRatio = msoTrue
cht3.Activate
With ActiveChart
.FullSeriesCollection(1).Name = "=""NAME 3"""
.ChartTitle.Text = "TITLE 3"
End With
For Each cht In wsG.ChartObjects
cht.Activate
With ActiveChart
.Legend.Delete
.ChartTitle.Font.Size = 14
.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.150000006
.Transparency = 0
.Solid
End With
Selection.Left = 27.536
Selection.Top = 5
.ChartArea.Select
With Selection.Format.Line
.Visible = msoFalse
End With
With .Axes(xlValue).TickLabels.Font
.Size = 11
End With
.Axes(xlValue).Select
Selection.Format.Line.Visible = msoFalse
.Axes(xlValue).MajorGridlines.Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
.Visible = msoTrue
.DashStyle = msoLineDash
End With
End With
Next cht
End Sub
If you want to ignore Chart 3 and Chart 2, add these two names to an array. Then check whether the chart object has name from this array and act accordingly:
Public Sub TestMe()
Dim myChart As ChartObject
Dim chartCount As Long
Dim cnt As Long
Dim chartNamesToExclude As Variant
chartNamesToExclude = Array("Chart 3", "Chart 2")
For Each myChart In Worksheets(1).ChartObjects
If Not valueInArray(myChart.Name, chartNamesToExclude) Then
cnt = cnt + 1
myChart.Chart.ChartTitle.Text = "Title" & cnt
End If
Next myChart
End Sub
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If CStr(myValue) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
The code above loops through all the charts in Worksheets(1) and changes their titles accordingly to Title N. It ignores the charts with names Chart 3 and Chart 2, by seeing that these are in chartNamesToExclude array.
Thanks Vityata. You solution worked but I think I have found what I was looking for in the beginning. I am not sure if it is better, but it does the job also. Here it is. Cheers, Daniel
Private Sub newtest()
Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range
Dim cht As ChartObject, cht1 As ChartObject, cht2 As ChartObject, cht3 As ChartObject
Dim LastRow As Long
Dim wsG As Worksheet: Set wsG = ThisWorkbook.Worksheets("Charts Radio")
Dim wsS As Worksheet: Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
Dim i As Long
For i = 67 To wsG.ChartObjects.count
wsG.ChartObjects(i).Activate
With ActiveChart
.Legend.Delete
.ChartTitle.Font.Size = 14
.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0.150000006
.Transparency = 0
.Solid
End With
Selection.Left = 27.536
Selection.Top = 5
'Added more formating / code here
End With
Next
End Sub
I'm trying to loop through a bar graph and make any values above 2 red. The below code is currently working but I want to get around using .Activate
Sub Works()
Dim wbk As Workbook
Dim ws As Worksheet
Dim x As Integer
Set wbk = ThisWorkbook
Set ws = wbk.Worksheets(1)
With ws
.ChartObjects("Chart 1").Activate
For x = 1 To ActiveChart.SeriesCollection(1).Points.Count
If ActiveChart.SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
'If above 2 make Red
ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
'If below or equal to 2 make Blue
ActiveChart.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
End If
Next x
End With
End Sub
This was my proposed solution but I get a Run-time 438 error when I try to initiate the For loop. I'm assuming it's just a syntax error but I can't figure out how to do it without .Activate
Sub Fails()
Dim wbk As Workbook
Dim ws As Worksheet
Dim x As Integer
Set wbk = ThisWorkbook
Set ws = wbk.Worksheets(1)
With ws.ChartObjects("Chart 1")
For x = 1 To .SeriesCollection(1).Points.Count
If .SeriesCollection(1).Points(x).DataLabel.Caption > 2 Then
'If above 2 make Red
.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
'If below or equal to 2 make Blue
.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
End If
Next x
End With
End Sub
The reason for your error already described to you by #A.S.H in the comments to your post.Series is a property of ChartObject.Chart and not ChartObject.
Try the code below, you could take advantage of VBA's chart capabilities with defining the following types of variables:
Dim ChtObj As ChartObject
Dim Ser As Series
Dim SerPoint As Point
Code
Option Explicit
Sub Fails()
Dim wbk As Workbook
Dim ws As Worksheet
Dim ChtObj As ChartObject
Dim Ser As Series
Dim SerPoint As Point
Set wbk = ThisWorkbook
Set ws = wbk.Worksheets(1)
Set ChtObj = ws.ChartObjects("Chart 1") '<-- set chart object
With ChtObj
Set Ser = .Chart.SeriesCollection(1)
For Each SerPoint In Ser.Points
If SerPoint.DataLabel.Caption > 2 Then 'If above 2 make Red
SerPoint.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else 'If below or equal to 2 make Blue
SerPoint.Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
End If
Next SerPoint
End With
End Sub
As noted in the comment by A.S.H., .Chart is the way to do it. However, you may also declare the chart as a chartObject and use the With myChart.chart in order to get the bonuses from the early binding.
Option Explicit
Sub Fails()
Dim ws As Worksheet
Dim myChart As ChartObject
Dim x As Long
Set ws = ThisWorkbook.Worksheets(1)
Set myChart = ws.ChartObjects("Chart 2")
With myChart.chart
For x = 1 To .SeriesCollection(1).Points.Count
'I have changed a bit the line below, as far as I could not achieve what were you doing...---v
If CLng(.SeriesCollection(1).Name) > 2 Then
.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
.SeriesCollection(1).Points(x).Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
End If
Next x
End With
End Sub
I have following code -
Option Explicit
Sub main()
Dim oPPTApp As PowerPoint.Application
Dim oPPTObj As Object
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
Dim oGraph As Graph.Chart
Dim oAxis As Graph.Axis
Dim SlideNum As Integer
Dim strPresPath As String, strNewPresPath As String
strPresPath = "Location.ppt"
strNewPresPath = "Destination.ppt"
'instantiate the powerpoint application and make it visible
Set oPPTObj = CreateObject("PowerPoint.Application")
oPPTObj.Visible = msoCTrue
Set oPPTFile = oPPTObj.Presentations.Open(strPresPath)
SlideNum = 1
Set oPPTSlide = oPPTFile.Slides(SlideNum).Select
Set oPPTShape = oPPTSlide.Add(1, ppLayoutBlank)
oPPTSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 10, 20, 300, 5
With oPPTSlide.Shapes(1).TextFrame.TextRange
.text = "ALL BSE"
.Font.Color = vbWhite
.Font.Underline = msoFalse
End With
End Sub
I get an error
Expected Function or Variable
at the following line:
Set oPPTSlide = oPPTFile.Slides(SlideNum).Select
Any help would be appreciated.
Following my comment above, you can't Set and Select at the same line (also, there's almost never any reason to use Select). Try Set oPPTSlide = oPPTFile.Slides(SlideNum)
However, a few "upgrades" to your code:
Directly set the oPPTShape with the new created Shapes with :
Set oPPTShape = oPPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 20, 300, 5)
and afterwards, easily modify the oPPTShape properties, using the With statement below:
With oPPTShape.TextFrame.TextRange
.text = "ALL BSE"
.Font.Color = vbWhite
.Font.Underline = msoFalse
End With
Should be...
Set oPPTSlide = oPPTFile.Slides(SlideNum)
The code below takes the ranges specified in excel and imports the range to PowerPoint. My struggle is that i am trying to add a slide title for each slide in the code but the syntax below doesn’t work (Header1 = "test"). Can you help if possible? Thanks in advance!!
Sub export_to_powerpoint()
Dim PPAPP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Integer
Dim shptbl As Table
Set PPAPP = New PowerPoint.Application
Dim cht As Excel.ChartObject
Dim Header1 As String
PPAPP.Visible = True
'create new ppt:
Set PPPres = PPAPP.Presentations.Add
For ii = 1 To 10
PPPres.Slides.Add PPPres.Slides.Count + 1, ppLayoutTitleOnly
Next ii
PasteRng PPPres, 1, Range("A2:S24")
PPSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
Header1 = "test" 'Titel on the first slide
PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
PasteRng PPPres, 2, Range("A25:S47")
PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
PasteRng PPPres, 3, Range("v2:am24")
'Adjust the positioning of the Chart on Powerpoint Slide
PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPAPP = Nothing
End Sub
Sub PasteRng(Pres, SlideNo, Rng As Range)
Rng.Copy ' copy the range
Pres.Application.ActiveWindow.View.GotoSlide SlideNo 'PPSlide.SlideIndex ' activate the slide no
Pres.Application.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method
End Sub
Your code works. It's doing exactly what you asked it to do (which may differ from what you expect...), when you
Dim Header1 as String
You create a string variable, capable of holding a string data.
Then you assign to it:
Header1 = "test" 'Titel on the first slide
Nowhere in your code have you even attempted to use this string to write to a slide's title. you need to assign this to the slide's title object.
Header1 = "test"
Dim sldTitle as Object
If Not ppSlide.Shapes.HasTitle Then
'If there is no title object then assume the slideLayout does not permit one
' so do nothing.
Else:
Set myTitle = ppSlide.Shapes.Title
'Assign the title text:
myTitle.TextFrame.TextRange.Characters.Text = Header1
End If
This will come in handy for you:
http://msdn.microsoft.com/en-us/library/office/ff743835(v=office.14).aspx