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.
Related
I have a code to paste object from a slide to the active slide. How can I make the code to paste it inside the master instead?
Public Function AddShapeBooktitle()
Dim s As String, p As Presentation, o As Shape
'open the file and copy the object
If CommandBars.ActionControl.Parameter <> "" Then
s = Ini.GetResourcePath & CG_ADDIN_NAME & "\" & CG_INSERT_FOLDER & CG_BOOKTITLE_FOLDER & CommandBars.ActionControl.Parameter
Set p = Presentations.Open(s, ReadOnly:=True, WithWindow:=msoFalse)
p.Slides(1).Shapes.Range().Copy
p.Close
ActiveWindow.Selection.SlideRange(1).Shapes.Paste
Else
MsgBox "The Shape file name is missing.", vbExclamation, "Shape file name missing."
End If
End Function
Appreciate any pro help out there! Thanks!
You'll need to identify the current slide's custom layout, and then paste the shapes into the appropriate layout in the SlideMaster. Something like this works within a single presentation. If you're working between multiple presentations with potentially different SlideMaster collections, you may need to adjust the logic somehow. But this is the general idea: you need to identify which of the SlideMaster.CustomLayouts will be the destination for the Paste operation.
Option Explicit
Sub foo()
Dim p As Presentation
Dim sld As Slide
Dim layout As CustomLayout
Set p = ActivePresentation
Set sld = p.Slides(1)
layout = sld.CustomLayout.Index
sld.Shapes.Range().Copy
p.SlideMaster.CustomLayouts(layout).Shapes.Paste
End Sub
I have a shape (rectangle) created inside a canvas in Microsoft word 2013, with Left:=100
But when I read the left property of the shape, I get a number different from the one I have set in creation phase!
Sub DRTEXT()
Dim shp1 As Shape, shpCanvas As Shape
Set shpCanvas = ActiveDocument.Shapes.AddCanvas(Left:=0, Top:=0, Width:=400, Height:=400)
Set shp1 = shpCanvas.CanvasItems.AddShape(Type:=msoShapeRectangle, _
Left:=100, Top:=100, Width:=100, Height:=100)
MsgBox shp1.Left '(shows the number 5!)
shp1.Left = 200
MsgBox shp1.Left
End Sub
I feel this might be of the shape being inside a canvas which wont let me to move the shape as I want.
Any clues?
Many thanks
I wrote some code for a client which isn't working correctly on his machine (Win 10, Office 365) but is on mine (Win 10, Office 2016). The code inserts an image to the header then positions it and resizes it. I use the ConvertToShape method so I can access properties like width, height and position of the Shape class.
Dim pic As Shape
Dim shp As Word.InlineShape
Set shp = thisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(fpImage) ' insert the image to the header
Set pic = shp.ConvertToShape ' THIS LINE CAUSES THE PROBLEM
The method causes the image to disappear. 'Pic' is still available and setting it's properties causes no error, but it is not visible. It's .visible property returns true.
Any ideas? Thanks.
Answer provided to cross-post at Microsoft Community
There is a way to do this with only an inline shape, by setting up a table to position the text on the left and the picture on the right. An additional advantage of this method is that, if you set the table's AutoFitBehavior property to wdAutoFitFixed and set the column width to the width you want for the shape, Word will automatically resize the picture to that width and keep the aspect ratio.
Here's a little sample macro:
Sub x()
Dim fpImage As String
Dim strExistingHeaderText
Dim tbl As Table
Dim shp As InlineShape
fpImage = "D:\Pictures\bunnycakes.jpg"
With ActiveDocument
strExistingHeaderText = _
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text
Set tbl = .Tables.Add( _
Range:=.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
numrows:=1, numcolumns:=2, _
AutoFitBehavior:=wdAutoFitFixed)
tbl.Columns(2).Width = InchesToPoints(1.5)
tbl.Columns(1).Width = InchesToPoints(5#)
tbl.Cell(1, 1).Range.Text = strExistingHeaderText
'tbl.Borders.Enable = False
Set shp = tbl.Cell(1, 2).Range.InlineShapes.AddPicture(fpImage)
End With
End Sub
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.
I am trying to select a slide by name. I have added a title via the outline. below is the code that is not working. "item Idaho not found in the slide collection"
ActivePresentation.Slides("Idaho").Select
The slide's name and the text in the title placeholder nave nothing to do with one another.
Unless you've renamed it, the first slide in the presentation will be named "Slide1", the second "Slide2" and so on.
If you specifically need a way to locate the slide whose title text = "Idaho", you'd need to write a function to search all the slides in the presentation and return the first one it finds that meets your criteria. For example:
Sub TestMe()
Dim oSl As Slide
Set oSl = FindSlideByTitle("idaho")
If Not oSl Is Nothing Then
MsgBox "Found your title on slide " & CStr(oSl.SlideIndex)
End If
End Sub
Function FindSlideByTitle(sTextToFind As String) As Slide
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
With oSl.Shapes.Title.TextFrame
If .HasText Then
If UCase(.TextRange.Text) = UCase(sTextToFind) Then
Set FindSlideByTitle = oSl
End If
End If
End With
Next
End Function
Reviving an old question, but I wanted to throw this in.
While it's possible that ActivePresentation.Slides("MySlideName").Select doesn't work, this does work for me in PPT 2010:
Dim PPTObj As PowerPoint.Application
Set PPTObj = New PowerPoint.Application
Dim PPTClinic As PowerPoint.Presentation
Set PPTClinic = PPTObj.Presentations.Open(FileName:="Your File Name Here")
PPTClinic.Slides("MySlideName").Select
This, of course, assumes that there is a slide named "MySlideName". Your code will have to deal with gracefully handling the Item MySlideName not found in the Slides collection. error (err.number = -2147188160).