I am trying to create a shape on a slide in PowerPoint (2010) VBA
I have created a button and this code:
Private Sub AddShape_Click()
Dim shp As Shape
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=24, Top:=65.6, Width:=672, Height:=26.6)
'No Shape Border
shp.Line.Visible = msoFalse
'Shape Fill Color
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
When I run the presentation as a slide show and click the Add Shape button, I get the following error:
Run-time error '-2147188160 (80048240)':
Application (unknown member): Invalid request. There is no currently active document window.
Everything I have found online indicates that this code should run OK.
All assistance appreciated!!!
Carolyn
You will get the No Current Active Document Window error if you run your code while the presentation is in Slideshow (fullscreen) mode. Try this, instead:
set sld = Application.ActivePresentation.SlideShowWindow.View.Slide
Things work differently in slide show view, but a couple very simple modifications will get this fixed up. Add this to the project and assign the AddShape_Click as an Action Setting (Run Macro):
Public Sub AddShape_Click(oBtn As Shape)
' It has to be public for the action setting to see it
Dim shp As Shape
Dim sld As Slide
'Set sld = Application.ActiveWindow.View.Slide
Set sld = oBtn.Parent
Set shp = sld.Shapes.AddShape(Type:=msoShapeRectangle, _
Left:=24, Top:=65.6, Width:=672, Height:=26.6)
'No Shape Border
shp.Line.Visible = msoFalse
'Shape Fill Color
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
You can also get this error if PowerPoint recently crashed and is still running in the background. Try killing any such powerpoint processes using task manager and then try again.
Related
I am trying to change the text color of the chart title of a histogram chart in PowerPoint.
Here is what I do:
var colorFormat = chart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor;
colorFormat.RGB = ...;
// or
colorFormat.ObjectThemeColor = ...;
This works for the standard charts like line charts. But it doesn't work for other chart types like histogram, waterfall, tree map etc.
In these cases, setting ObjectThemeColor sets the text to black. Setting RGB does actually set the correct color. However, in both cases, as soon as the user changes the selection, the text color jumps back to the one it had previously.
How can I set the text color of the title of one of these charts?
I am using VSTO and C# but a VBA solution is just as welcome as long as it can be translated to C# and still work.
Based on what info you gave I built a histogram and waterfall chart in PowerPoint and was successful using:
Sub ChartTitleFontColor()
Dim oShp As Shape
Dim oCht As Chart
'Waterfall on slide 1
Set oShp = ActivePresentation.Slides(1).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then
Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
'Histogram on slide 2
Set oShp = ActivePresentation.Slides(2).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
Your code works in my test. I created two charts in PowerPoint 2016, the first one a waterfall, and the second another type. The following code changes the title color only (and text just a proof of it being changed) and nothing else. I can select the other chart and nothing changes. I could not find a bug about this in a search. Perhaps something in the remaining code is changing it back?
Sub test()
Dim myPresentation As Presentation
Set myPresentation = ActivePresentation
Dim myShape As Shape
Set myShape = myPresentation.Slides(1).Shapes(1)
Dim theChart As Chart
If myShape.HasChart Then
Set theChart = myShape.Chart
If theChart.ChartTitle.Text = "This is blue" Then
theChart.ChartTitle.Text = "This is yellow"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 0)
Else
theChart.ChartTitle.Text = "This is blue"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
End If
End If
End Sub
This is not exactly an answer but I think you should name your object.
Instead of using
ActivePresentation.Slides(1).Shapes(1)
You can name the object.
Code that perfectly works in earlier versions of PPT stopped working in 2016.
When I try to change the left property of a shape in a chart, I get a Method left of object shape failed error.
I can perfectly read the .Left property.
I am running out of ideas? What can I do?
Sub test11()
Dim sld As Slide
Dim objChart As Object
Dim shpBubble As Object
Set sld = ActivePresentation.Slides("ScatterPlot01_Purch6")
Set objChart = sld.Shapes("Chart01").Chart
sld.Select
objChart.Select
Set shpBubble = objChart.Shapes("P01")
'shpBubble.Select
Debug.Print shpBubble.Left, shpBubble.Visible
shpBubble.Left = 10
End Sub
UPDATE
Having tested in PowerPoint 2010 and 2013, where it works, this now looks like a bug in 2016!
* END *
I managed to recreate the error in PowerPoint 2016 (PC) by manually adding a shape to a test chart (select the chart then click Format / Insert Shapes) and trying to write to several of it's properties including position and formatting such as changing fill colour. All generate an error.
Maybe one workaround is to use the .Delete method to delete the desired shape and then add a new shape at the required size and position. Something like this:
Sub test11()
Dim sld As Slide
Dim objChart As Chart 'Object
Dim shpBubble As Shape 'Object
Set sld = ActivePresentation.Slides("ScatterPlot01_Purch6")
Set objChart = sld.Shapes("Chart01").Chart
sld.Select
objChart.Select ' this won't work as you can only select the parent shape sld.Shapes("Chart01")
With objChart
.Shapes("P01").Delete
.Shapes.AddShape msoShapeOval, 10, 10, 20, 20
End With
End Sub
The challenge is that because the new shape is added as read only, the formatting can't be set!
I am trying to create a VBA that creates a green up arrow with no border. Currently the VBA is creating a green arrow with a black border. Can anyone help me out with this? My code is below. I tried shp.Line.Fill.ForeColor.RGB = RGB(137, 143, 75)and was still getting the black outline.
Thanks in advance.
Sub Up_Arrow()
Dim i As Integer
Dim shp As Shape
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
Set shp = sld.Shapes.AddShape(35, 10, 10, 5.0399, 8.6399)
shp.Fill.ForeColor.RGB = RGB(137, 143, 75)
shp.Fill.BackColor.RGB = RGB(137, 143, 75)
End Sub
Update: Probably not the most sophisticated way to do it but following line of code worked.
shp.Line.ForeColor.RGB = RGB(137, 143, 75)
shp.Line.Visible = msoFalse
is what you need.
In fact, you can obtain the code required by recording a macro :)
You can make the line invisible this way:
shp.Line.Visible = MsoFalse
I have a subroutine that will create a shape, but I have two problems with the code:
I must specify on which slide this shape will be created. This is a problem if I want to create the same shape on multiple slides simultaneously. How do I achieve that? what do I replace activepresentation.slides(x) with?
I want the shape to have a hyperlink to a specific slide. What is wrong with my code to achieve that? It gives me an error when I try to assign an action to the shape I have created.
Sub createshape()
Dim oshp As Shape
Dim osld As Slide
'old code
Set osld = ActivePresentation.Slides(1)
Set oshp = osld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
oshp.ActionSettings (ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 1 'this should take the hyperlink to slide 1 i hope.
End Sub
I want to automate this function because I will be doing this same thing for many many slides multiple times.
Something like this will act on the current slide. I tested for a slide 2 hyperlink to esnure that the code worked (and didn't use 1 as default)
Sub CreateShape()
Dim oShp As Shape
Dim oSld As Slide
Set oSld = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
Set oShp = oSld.Shapes.AddShape(msoShapeRectangle, 485, 15, 104, 60)
With oShp.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
'.Hyperlink.Address = SlideNumber
.Hyperlink.SubAddress = 2
End With
End Sub
I trying to make PowerPoint load up images to replace placeholders everytime a slide changes.
I have the code working, which changes the placeholders with images from local drive or url. But it wont work on OnSlideShowPageChange() event(mentioned here). With no prior experience on VB/VBA, I have no idea why, as it does not give any errors. I know the event is accessed because if I put a MsgBox()-function in it, it is displayed.
ImageReplace code:
Dim strPicName As String
Dim shp As Shape
Dim sglShapeLeft As Single
Dim sglShapeTop As Single
Dim sglShapeHeight As Single
Dim sglShapeWidth As Single
'Get the name of the shape (image)
'Provided this is the only shape on the slide
'Since I don't think you can use the ME. keyword to reference an impage from Powerpoint VBA
'(Me.shape.Name)
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
'Select the Image
ActiveWindow.Selection.SlideRange.Shapes(strPicName).Select
'Get the Left and Top starting points and width and height
sglShapeLeft = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Left
sglShapeTop = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Top
sglShapeHeight = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Height
sglShapeWidth = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Width
'Delete the Image
ActiveWindow.Selection.ShapeRange.Delete
'Insert a new Image at the same starting points as the previous image
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=sglShapeLeft, Top:=sglShapeTop, Width:=sglShapeWidth, Height:=sglShapeHeight).Select
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
ActiveWindow.Selection.SlideRange.Shapes(strPicName).IncrementRotation 276#
Any help is appreciated
ActiveWindow is not accessible when in slide show view.
Try this instead
Dim sld As Slide
Set sld = ActivePresentation.Slides _
(ActivePresentation.SlideShowWindow.View _
.CurrentShowPosition)
Set shp = sld.Shapes(1)
With shp
sld.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).IncrementRotation 276#
.Delete
End With
BTW, debugging and exceptions do not seem to be supported in the OnSlideShowPageChange event. As an easy approach place a MsgBox after each line of code to see where the execution stops.