I write the code below in ppt vba, for taking, in each slide, each shapes height, top, left, width paramateres. Then my idea is to copy the same paramateres in vba from excel for copying and pasting the OLEObjects to the exact same places on the slide. But gives error on mentioned line below. Any ideas why?
I am looking for a reason, why it gives the error;
For each sh In ActivePresentation.Slides.Shapes.
The data member or method was not found..
Sub chngshp()
Dim sl As Slides
Dim sh As Shapes
Set sl = ActivePresentation.Slides
Set sh = ActivePresentation.Shapes
For each sl In ActivePresentation
For each sh In ActivePresentation.Slides.Shapes
Debug.Print ActivePresentation.Slides.Shapes.Name
Debug.Print ActivePresentation.Slides.Shapes.Height
Next
Next
End Sub
The set statements are not needed. Here's how your code should be written:
Sub chngshp()
Dim sl As Slide
Dim sh As Shape
For each sl In ActivePresentation.Slides
For each sh In sl.Shapes
Debug.Print sh.Name
Debug.Print sh.Height
Next sh
Next sl
End Sub
Related
Goal:
-Loop through presentation checking each slide for a certain title
-Once title is found
-Copy the shapes for the charts and footnote
-Then paste them into a separate presentation.
Notes:
-The slides in the presentations don't have titles but are located at Shapes(1)
-I receive a
run-time error '-2147024809 (80070057)': The specified value is out of
range.
-This error occurs on the line of the If statement
Sub library_update()
Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")
Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")
Dim sld as slide
For Each sld In NTppt.Slides
If sld.Shapes(1).TextFrame.TextRange.Text = "Fixed Income - Yield Curves" Then
With NTppt
sld.Shapes.Range(Array(2, 3)).Copy
ppt.Slides(1).Shapes.Paste
End With
End If
Next sld
End Sub
The solution below worked. I am not sure why my code produced the original run time error but I assume it has something to do with not finding shapes(1) in some of my powerpoint slides.
To fix the problem, I searched for "Fixed Income - Yield Curves" in all shapes of all slides.
Sub library_update()
Dim NTppt As Presentation
Set NTppt = Application.Presentations("Z:\NTPath\NLibrary.pptx")
Dim ppt As Presentation
Set ppt = Application.Presentations("Z:\NTPath\Library.pptm")
Dim sld As Slide
Dim shp As Shape
For Each sld In NTppt.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txt_range = shp.TextFrame.TextRange
'Confirm exact spelling and capitalization of the slides or an error will return
If txt_range = "Fixed Income – Yield Curves" Then
With NTppt
sld.Shapes.Range(Array(2, 3)).Copy
ppt.Slides(2).Shapes.Paste
End With
End If
End If
Next shp
Next sld
End Sub
I am trying to apply a template on all charts in my PPT, but get an error stating
User-defined type not defined
I found the VBA online, and the person sharing it said it worked for him. Any suggestions? I thought it might be the dashes in the pathway, but using "-" or "_" does not help. Also tried removing the last parenthesis after the pathway.
Sub ChangeCharts()
Dim myChart As ChartObject
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.ApplyChartTemplate ( _
"Name\Users\Name\Library\Group Containers\UBF8T346G9.Office\User Content\Chart Templates\1.crtx")
Next myChart
End Sub
New VBA tried;
Sub ChangeCharts()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
Select Case oSh.Type
Case Is = 3 ' Chart created in PPT
Application.ActivePresentation.ApplyTemplate _
"name/Users/name/Library/Group Containers/UBF8T346G9.Office/User Content/Chart Templates/1.crtx"
End Select
Next ' oSh/Shape
Next ' oSl/Slide
End Sub
First, see the comments below to learn why your sample code can't work in PPT:
Sub ChangeCharts()
' PPT has no ChartObject type
Dim myChart As ChartObject
' PPT has no ActiveSheet object
For Each myChart In ActiveSheet.ChartObjects
myChart.Chart.ApplyChartTemplate ( _
"Name\Users\Name\Library\Group Containers\UBF8T346G9.Office\User Content\Chart Templates\1.crtx")
Next myChart
End Sub
Assuming you're running this from within PPT, you'll need something more like:
Sub ChangeCharts
Dim oSl as Slide
Dim oSh as Shape
For Each oSl in ActivePresentation.Slides
For Each oSh in oSl.Shapes
Select Case oSh.Type
Case Is = 3 ' Chart created in PPT
' apply the template here
With oSh.Chart
.ApplyChartTemplate "drive:\path\template_name.crtx"
End with ' the chart
' Other case statements as needed to
' cover embedded/linked OLE objects
' that are Excel charts
End Select
Next ' oSh/Shape
Next ' oSl/Slide
End Sub
ActiveSheet is an Excel object. I think you want to use ActiveSlide for PowerPoint.
I have a spreadsheet which contain several hyperlinks, some of which are from shapes. I am trying to loop through them, to see where each of them point in order to later remove some of them. For the hyperlinks contained in cells the following loop has worked:
Sub a()
Dim ws As Worksheet, hl As Hyperlink, o As Shape
For Each ws In Worksheets
For Each hl In ws.Hyperlinks
Debug.Print hl.Address
Next
Next
End Sub
But that seems to skip all the hyperlinks originating from shapes or other objects.
Is there any way I can loop through those as well? I have tried stuff like:
Sub a()
Dim ws As Worksheet, hl As Hyperlink, o As Shape
For Each ws In Worksheets
For Each o In ws.Shapes
For Each hl In o.Hyperlinks
Debug.Print hl.Address
Next
Next
Next
End Sub
But that gives me a runtime error 91 on the debug.print line. Googling gives me nothing. So, have any of you got an idea of how to print the addresses?
A Shape doesn't have a .Hyperlinks property, only a .Hyperlink one and you'll get an error from it if there is no associated hyperlink, so you need an error handler. For example:
On Error Resume Next
Set hl = o.Hyperlink
On Error GoTo 0
If Not hl Is Nothing Then
Debug.Print hl.Address
set hl = Nothing
End If
I'm new to PowerPoint VBA so please bear with me.
I would like to:
loop through all the slides on a given pptx,
loop through all the shapes on a given slide,
find chart shapes
loop through the chart's series collection
set the datalabel color property to dark black.
So far I have been able to complete the first 3 tasks but I need help with the last 2. Here is my code:
Sub test()
Dim slide As Object
Dim shape As Object
Dim shapeNames As Object
Dim chSeries As Series
i = 0
For Each slide In ActivePresentation.Slides
For Each shape In slide.Shapes
If shape.HasChart Then
i = i + 1
Debug.Print "found a chart on slide", i
End If
Next
Next
End Sub
Solved.
Sub test()
Dim sld As Slide
Dim shp As Shape
Dim sr As Series
Dim chrt As Chart
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Debug.Print shp.Chart.ChartType
If shp.Chart.ChartType = 57 Then
shp.Chart.SeriesCollection(1).DataLabels.Font.Color = RGB(0, 0, 0)
End If
End If
Next shp
Next sld
End Sub
Though I didn't successfully loop over the series in chart but this works.
I have a powerpoint presentation with an excel workbook embedded in one of the slides. I also have a userform that I want the user to input information into, I want to take this information and then edit the excel sheet with the relevant information.
I don't know how to access the excel sheet within powerpoint though so I can change the values of the cells.
Sub a()
Dim oSl As PowerPoint.Slide
Dim oSh As PowerPoint.Shape
Set oSl = ActivePresentation.Slides(1)
Set oSh = oSl.Shapes(1)
With oSh.OLEFormat.Object.Sheets(1)
.Range("A1").Value = .Range("A1").Value + 1
.Range("A2").Value = .Range("A2").Value - 1
End With
Set oSl = Nothing
Set oSh = Nothing
End Sub
Inspired in this code