I am trying to create a new PowerPoint plug-in. I have run into a problem for a case where I want to determine if for a given shape on slide 1, whether the same shape also exists on the next slide.
Is there a way by which I can compare shapes from different slides and determine whether they are the same?
I can probably compare the type, dimensions, text and other similar properties, but this may not be the right way to solve this problem. Is there a better way to do this?
Something like this will return an "identical" shape from another slide if it meets your criteria. You could have it return True/False instead if you prefer:
Function SameShape(oThisShape As Shape, oOtherSlide As Slide) As Shape
Dim oSh As Shape
For Each oSh In oOtherSlide.Shapes
If oSh.Type = oThisShape.Type Then
If oSh.Height = oThisShape.Height Then
If oSh.Width = oThisShape.Width Then
' other conditions here as required
Set SameShape = oSh
Exit Function
End If
End If
End If
Next
End Function
One caveat: if the shape's .Type = msoPlaceholder, you'll also need to look to see whether .PlaceholderFormat.ContainedType is the same.
What is an "identical" Shape for you?
All shapes hafe different IDs so you cannot compare them, but you could compare the Size, the location (Shape.Width, Shape.Height etc.) and maybe the content (a chart, a table or text?).
If enough Properties are equal they might be considered as equal.
Related
I have an excel file which contains 1000+ pictures. The pictures are embeded in Column J of each row.
I have a userform which allows user to update a picture. What I want is to delete the picture that is present in the cell before updating a new picture.
The code that I found and tried to use:
Dim curPic As Shape
For Each curPic In Worksheets("Sheet1").Shapes
If Not Application.Intersect(curPic.TopLeftCell, PicCell) Is Nothing Then
curPic.Delete
End If
Next curPic
The thing is since I have a 1000+ pic, it checks each and every picture and I get a "Not Responding" on the file.
Is there a way to search only in a particular cell since I know the cell location.
Assumption: the top left corner of the shape is within the particular cell.
This routine takes the cell you want to check - and then compares the topLeftCell-Address of each shape against the address of your cell.
If they match, shape will be deleted.
What is different to your code: I am comparing the addresses of the ranges and am not intersecting ranges. I suppose this will be faster but haven't tested it.
Furthermore the for-next-loop is exited as soon as the shape has been found. That means the routine will be faster for the first cells in your column but slower for the last cells.
Option Explicit
Sub deleteShapeInRange(rgCell As Range)
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.TopLeftCell.Address = rgCell.Address Then
shp.Delete
exit for
End If
Next
End Sub
I am looking to write a generalized PowerPoint macro to group specific shapes together. The problem is I do not know the specific shape names ahead of time as my slidedeck changes slighty each time. Here is my situation: I have a collection of PowerPoint shapes whose names start with the prefix "rc". For example they could be "rc48", "rc49","rc50","rc51". They are always in increasing numerical order and the only "rc" named shapes on the slide. Following these shapes, I have a collection of shapes with the prefix "tx" (they are not the only "tx" shapes in the slide but they do always follow the "rc" shapes) and there are always an equivilant number of "tx" objects following the "rc" objects. So in this example I would have "tx52", "tx53","tx54","tx55".
What I would like to do is group these pairs of objects together. So group1 would be ("rc48","tx52"). group2 would be ("rc49","tx53") and so on.
I know very little about coding in VBA, but my approach in other programming languages would be to find the positions of the "rc" shapes in the sequential shape names vector and then count length(rcshapes_vector) past the "rc" positions to find the "tx" shapes I need and then loop over these pairs.
I realize this is a complicated question, but any help would be greatly appreciated.
Working with vba code in PowerPoint is really painful because you don't have a lot of functions such as Excel vba but I hope the following ideas can help you:
You can validate the type of Shape like If oShp.Type = msoTextBox Then or If oShp.Type = msoPicture Then.
Also for each Shape you can validate the top or left property to find the position in the slide.
If you are sure your shapes have those names, maybe you can try with:
Dim oShp As Shape
For Each oShp In ActivePresentation.Slides(SldNumber).Shapes
If oShp.Name = "rc49" Then
Do Something
End If
next
Is there a way to count number of rows of texts inside a Visio shape? Such as linecount?
I've tried Rowcount on a Visio shape and it didn't return anything reflecting the text lines inside the Visio Shape! Below is that sample code I created
Sub something()
Dim intRows
Dim vsoShape As Visio.Shape
Set vsoShape = ActiveWindow.Selection.PrimaryItem
intRows = vsoShape.RowCount(Visio.visSectionProp)
MsgBox intRows
End Sub
There is no built-in way to count the number of lines of text, that I'm aware of.
The RowCount is for counting the number of rows in a particular shapesheet section.
You can call the BoundingBox method on a shape and get back the height and width of the text area for the shape, but you'd have to guess at how many lines that is, maybe as a function of the font size.
If you are able to enforce a standard font and character size on shapes in the diagrams you're working with, you should be able to tell how many lines there are based on the height of the text box.
I'm assuming you're asking after the number of line wraps that Visio has done, not the number of line breaks in the text.
I'm automatically generating a powerpoint slide through VBA, User Forms, and Excel. You run the VBA script in excel, fill out the data, the data goes into cells in excel, then the VBA script pulls the data and puts it into textbox shapes in the slide.
My problem is I want to use different font sizes at different times, so for example 28 pt font for one part and 14 pt for the rest. The problem is that any property changes I make to the textbox applies to all of the text within the shape.
My current workaround is sloppy and is to just generate another textbox over the original and insert spacing in the original so it looks like the larger text is "in" the textbox while it's actually just sitting over a few empty lines set aside.
You can format specific substrings within a string, but it's very cumbersome, for example assuming shp is an object variable representing your textbox:
Sub foo()
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes("TextBox 3")
shp.TextFrame.TextRange.Text = "Hello, world!"
shp.TextFrame.TextRange.Characters.Font.Size = 14 'applies uniform font to entire shape
shp.TextFrame.TextRange.Characters(1, 5).Characters.Font.Size = 28
End Sub
Example output:
The difficulty of course is working with mixed formats, and I do not think there is any easy solution. It will be up to you to determine what formats you need to "capture", and what subsequently implement the appropriate conditional logic to transfer those formats to the PowerPoint shapes.
One possible alternative -- and this is the route that I would go if I were you -- would be to copy the cell from Excel, and use this method to paste in to PowerPoint. I believe this will create a table consisting of a single cell, in the PowerPoint slide. You will have to make adjustments for size/position, but this should be an order of magnitude easier than trying to capture every possible variation of font formatting:
Sub foo2()
Dim shp As Shape
Dim xl As Object
'Get Excel and copy a specific cell
Set xl = GetObject(, "Excel.Application")
xl.Workbooks("Book35").Sheets("Sheet2").Range("B4").Copy
'Paste that cell in to PowerPoint as a table, preserving formats:
ActivePresentation.Slides(1).Select
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End Sub
Example output, as copied from the Excel cell:
No need to change the font in excel to reflect in Word. You can do it directly. Just paste the below mentinoed line in Word VBA : -
Activedocument.Shapes("sam").TextFrame.TextRange.Words(1).Font.Size = 28
I need to know is selected shape word art or not.
Shape has property "Type" (returns enum MsoShapeType).
When I insert word art and check this property - it returns msoAutoShape instead of msoTextEffect (with AutoShapeType==msoShapeRectangle).
How can I check that spae is word art (not usual rectangle with textbox) ?
Thanks!
If you select either the overall smartart shape or click into text within the smartart shape or select one of the shapes within the smart art, ActiveWindow.Selection.ShapeRange(1) will return the smartart shape.
So
If ActiveWindow.Selection.ShapeRange(1).HasSmartArt Then
Debug.Print "It's smart art"
End if
[edited]
But as you've pointed out, this is for smartart, not word art. My error, sorry.
There isn't a WordArt shape as such; it's more like any shape that has had WordArt formatting applied to the shape as a whole or to text within the shape. That'd include formatting like glow, reflection, shadow and so on, or could be one of the WordArt presets, pre-selected combinations of these different effects. I've added an example that'll help identify shapes or ranges of text within shape that have these presets applied. I don't see any simple way of checking for user-applied WordArt formats other than looking at each run and each text box for each of the various properties (glow, reflection etc) that might be applied. Unfortunately, there's no WordArtFormat = None to tell us we can ignore it. It's either going to be one of the presets or -2, which can mean any of several things.
Sub WordArtist()
Dim oSh As Shape
Dim oRng As TextRange2
' Has word art formatting been applied to
' entire shape?
Set oSh = ActiveWindow.Selection.ShapeRange(1)
Debug.Print oSh.TextFrame2.WordArtFormat
' Has it been applied to individual chunks of
' text within the shape
For Each oRng In oSh.TextFrame2.TextRange.Runs
Debug.Print oRng.Font.WordArtFormat
Next
' Note:
' A result of -2 for the entire shape could mean
' - No text in the shape; not really word art
' - Mixed formatting
' - Text/shape has had glow/shadow/reflection etc applied
' rather than one of the preset WordArt selections
End Sub