Suppose I have a TextRange object, and I need to find the Shape that contains that TextRange.
Normally, I can use the Parent property of the TextRange to get the TextFrame that contains it, and then use the Parent property again to get the Shape.
However, if the text is within a table cell, the Parent property of the TextRange is Nothing. (I think this is a "feature" of PowerPoint 2010). EDIT: this is not true except when accessing the TextRange via Selection.TextRange.
Is there any other way I can identify the shape (which in this case would be the table cell)?
UPDATE: thanks to KazJaw, I have looked at this again, and it turns out I can navigate up the Parent chain unless the TextRange I'm starting from was obtained from Selection.TextRange. For my purposes, this is less of a problem.
Based on further discussion in comments below question it seems that the real problem refers to selection object. If one select any text within the table then some test made in Immediate have the following results:
? Typename(ActiveWindow.Selection.TextRange)
TextRange
? Typename(ActiveWindow.Selection.TextRange.Parent)
Nothing
? Typename(ActiveWindow.Selection.TextRange.Parent.Parent)
'>>Error
Additional information also for other programmers. The following I've found a bit confusing making some test to answer the question. (For simple presentation with one slide, one table in it and some cells filled with text)
Sub Test_To_SO()
Dim SL As Slide
Set SL = ActivePresentation.Slides(1)
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent)
'result >> TextFrame
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent.Parent)
'result >> Shape
Debug.Print TypeName(SL.Shapes(1).Table.Cell(1, 1).Shape.TextFrame.TextRange.Parent.Parent.Parent)
'result >> Slide !!
End Sub
It's not so much that you can't get there via the selection, it's sometimes a matter of what you've selected. The object model's broken for text in table cells. As noted, ActiveWindow.Selection.TextRange.Parent returns nothing for selected table cell text.
Other text:
Sub GetParentShape()
Dim oSh As Shape
With ActiveWindow.Selection
'Type might be None, Slides or one of the following:
If .Type = ppSelectionShapes Then
Set oSh = ActiveWindow.Selection.ShapeRange(1)
End If
If .Type = ppSelectionText Then
Set oSh = ActiveWindow.Selection.TextRange.Parent.Parent
End If
Debug.Print oSh.Name
End With
End Sub
Related
I've written some code that formats text. The code doesn't work if user has put the cursor in a shape that is part of a group of shapes, the solution for which is to ungroup the shapes.
I want to regroup the shapes after executing the formatting code.
I am able to store the underlying shapes as objects, as well as their names. But, the normal approach to grouping (using shape names) doesn't work, because there can be multiple instances of those shape names on a given slide. E.g. this doesn't work as there could be multiple instances of "textbox" on the slide:
Set TempShapeGroup = TempSlide.Shapes.Range(Array("textbox", "header", "separator")).Group
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shaperange.group
But, I have the shape objects stored in an array, the crux of which is this (the object 'TempShape' is the group of shapes):
Dim ShapesArray() As Shape
ReDim ShapesArray(1 To TempShape.GroupItems.Count)
For i = 1 To TempShape.GroupItems.Count
Set ShapesArray(i) = TempShape.GroupItems.Item(i)
Next i
So, what I want to do is recreate the group of shapes, using the array of shape objects, so something to the effect of the below would be ideal:
Set MyShapesGroup= ShapesArray.Group
But any way to group shapes using Shape objects would be fine.
TIA
Here's some starter code that you can modify into a function that'll return a reference to the paragraph that contains the current selection cursor. It doesn't really need all the debug.print stuff, of course, but that might help to illustrate the object hierarchy:
Sub WhereIsTheCursor()
Dim oRng As TextRange
Dim oParentRange As TextRange
Dim x As Long
Dim lSelStart As Long
Dim lSelLen As Long
With ActiveWindow.Selection.TextRange
' find the selection start relative to first character in shape
lSelStart = .Start
' lSelLen = .Length
Debug.Print TypeName(.Parent)
Debug.Print TypeName(.Parent.Parent)
Debug.Print TypeName(.Parent.Parent.Parent)
Debug.Print .Paragraphs.Count
Set oRng = .Characters(.Start, .Length)
Debug.Print oRng.Text
' Reference the overall shape's textrange
Set oParentRange = .Parent.Parent.TextFrame.TextRange
' For each paragraph in the range ...
For x = 1 To oParentRange.Paragraphs.Count
' is the start of the selection > the start of the paragraph?
If lSelStart > oParentRange.Paragraphs(x).Start Then
' is the start < the start + length of the paragraph?
If lSelStart < oParentRange.Paragraphs(x).Start _
+ oParentRange.Paragraphs(x).Length Then
' bingo!
MsgBox "The cursor is in paragraph " & CStr(x)
End If
End If
Next
End With
End Sub
Not sure I'm completely understanding the problem, but this may help:
If the user has selected text within a shape, it doesn't really matter whether the shape is part of a group or not. You may need to test the .Selection.Type and handle things differently depending on whether the .Type is text or shaperange. Example:
Sub FormatCurrentText()
If ActiveWindow.Selection.Type = ppSelectionText Then
With ActiveWindow.Selection.TextRange
.Font.Name = "Algerian"
End With
End If
End Sub
I have a Powerpoint-Slide with pasted, formatted source code in the form of text shapes. Sadly the contrast of some part of that text is bad on a projector, so I would like to change every colour occurence for a specific font with a different colour. In this specific example I want to replace the orange colour:
Iterating over all shapes and accessing the whole text of a shape is not a problem, but I can't find any property that allows me to enumerate over the styled text segments:
Sub ChangeSourceColours()
For Each pptSlide In Application.ActivePresentation.Slides
For Each pptShape In pptSlide.Shapes
If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
' Iterate over styled segments and change them if the previous colour is orangey
MsgBox pptShape.TextFrame.TextRange
End If
Next
Next
End Sub
The TextRange2 property looked helpful at a first glance, but looking at the variables in the debugger I see nothing that looks like a series of formatted segments. I would expect to find something like <span> in HTML to check and possibly change the colour.
The textFrame2.textRange.Font is valid for the whole text. If you want to access the single characters and their individual formatting, you need to access textRange.Characters.
The following routine changes the text color for all characters that have a specific color to a new color:
Sub ChangeTextColor(sh As Shape, fromColor As Long, toColor As Long)
Dim i As Long
With sh.TextFrame2.TextRange
For i = 1 To .Characters.Length
If .Characters(i).Font.Fill.ForeColor.RGB = fromColor Then
.Characters(i).Font.Fill.ForeColor.RGB = toColor
End If
Next i
End With
End Sub
You call it from your code with
Dim pptSlide as Slide
For Each pptSlide In Application.ActivePresentation.Slides
Dim pptShape As Shape
For Each pptShape In pptSlide.Shapes
If (pptShape.Type = 1) And (pptShape.TextFrame.TextRange.Font.Name = "Consolas") Then
ChangeTextColor pptShape, RGB(255, 192, 0), vbRed
End If
Next
Next
You will have to adapt the RGB-Code to the orange you are using, or instead of using RGB, you can use ObjectThemeColor. To avoid a type mismatch, you need to declare the pptShape variable as Shape - you should declare all your variables and use Option Explicit anyhow.
Note that you can use the ChangeTextColor-routine also in Excel (and probably also in Word). Shapes are defined similar in Excel and Powerpoint. Advantage in Excel: You can use the macro recorder to get some insights how a Shape can be used in Office VBA.
I would like to simplify updating my orgcharts in Visio. So far I have a macro borrowed from here https://bvisual.net/2010/01/28/applying-selected-datagraphic-to-the-whole-document/ and written out below. I would like to adapt it to make some changes to the format of the text withing shapes e.g. to make the font bold and potentially to change it's colour. I'm finding it really difficult to find examples of this online so any help/suggestion would be greatly appreciated.
Public Sub ApplyDataGraphicToDocument()
Dim mstDG As Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.Page
Dim firstProp As String
If Visio.ActiveWindow.Selection.Count = 0 Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
Set shp = Visio.ActiveWindow.Selection.PrimaryItem
If shp.DataGraphic Is Nothing Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
'Get the shapes DataGraphic master
Set mstDG = shp.DataGraphic
'Get the name of the first Shape Data row
firstProp = "Prop." & _
shp.CellsSRC(Visio.visSectionProp, 0, 0).RowNameU
End If
End If
For Each pag In Visio.ActiveDocument.Pages
If pag.Type = visTypeForeground Then
For Each shp In pag.Shapes
'Check that the named Shape Data row exists
If shp.CellExistsU(firstProp, Visio.visExistsAnywhere) Then
'Set the DataGraphic
shp.DataGraphic = mstDG
End If
Next
End If
Next
End Sub
You can modify the default OrgChart shapes, although it is not officially supported. To change the default shapes (make their font bold), you'll need to edit the templates (masters) for those OrgChart shapes. In the same blog you can find more information on customizing the OrgChart diagrams, here: https://bvisual.net/2012/05/08/creating-a-custom-org-chart-template-with-extra-properties
The procedure is mostly the same, just instead of adding the properties, you make the text bold.
I have been searching for hours to try to find the answer to this question, but to no avail, so I'm hoping I can find the answer here.
I want to create a variable that refers to a pre-existing chart in PowerPoint so I can start automating its data. I want to refer to the chart by its name to make things very easy, but no matter what I do I cannot seem to give PPT a satisfactory Chart address.
I have tried almost every possible variation of the below, but without success:
Dim chrtPP As PowerPoint.Chart
Set chrtPP = ActivePresentation.Slides(1).Shapes.Charts("Chart3")
Could someone please tell me what I'm doing wrong?
Thanks!
You need to reference the shape by name (a 'Shape" in PowerPoint is actually any object that is on a slide and can be a simple shape, textbox, table, chart, group, media clip etc.). If you're on PowerPoint 2010 and higher, press Alt+F10 to open the selection pane to find the name of the selected chart object. It may be a standard chart object or a chart within a placeholder object. You can then reference the chart as follows:
Option Explicit
Sub ChartStuff()
Dim oShp As Shape
Dim oCht As Chart
Set oShp = ActivePresentation.Slides(1).Shapes("Chart 3")
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
The key in programming PowerPoint is to ignore the object name in the Object Model for 'Shape' as it's very misleading!
I have a simple question regarding PowerPoint VBA:
Which VBA code should I use to switch between the "active sheet of paper" (I am sorry I don't know how to name it properly), in which I am doing something with the object(s), and the file (or "field", again sorry for my poor terminology) where all the slides are ?
For example, if I want to move a selected object in the "active sheet of paper" I would use this macro:
ActiveWindow.Selection.ShapeRange.IncrementLeft
6#
and if I want to copy the selected slide in the slides file, I would use this code:
ActiveWindow.Selection.Copy
ActiveWindow.View.Paste
But how can I connect these two pieces of script? Let's say I want to move an object in the "active sheet of paper", then copy this whole "sheet", then create its twin in the slides field, and then jump into the twin sheet of paper to do something with objects there?
Shortly, how do I switch from "paper" to "slides" and back to "paper" in VBA?
(Again, I am sorry for terrible terminology here, I hope you understand what I mean here.)
Thank you all in advance.
If you record a macro in PowerPoint and examine the code, you'll see that it uses the Selection object for just about everything. That's sometimes useful (because it means it's more likely that the code will do what you want if you select another object), but for anything more than a very short macro, it's probably better to refer to the objects directly, as in the following code:
Sub Test()
' Get the active presentation
Dim oPresentation As Presentation
Set oPresentation = ActivePresentation
' Get the first slide in the presentation
Dim oSlide As Slide
Set oSlide = oPresentation.Slides(1)
' Get the first shape on the slide
Dim oShape As Shape
Set oShape = oSlide.Shapes(1)
' Nudge the shape to the right
oShape.Left = oShape.Left + 1
' Copy the whole slide
oSlide.Copy
' Paste the slide as a new slide at position 2
Dim oNewSlides As SlideRange
Set oNewSlides = oPresentation.Slides.Paste(2)
' Get a reference to the slide we pasted
Dim oNewSlide As Slide
Set oNewSlide = oNewSlides(1)
' Get the first shape on the NEW slide
Dim oNewShape As Shape
Set oNewShape = oNewSlide.Shapes(1)
' Nudge the shape to the right
oNewShape.Left = oNewShape.Left + 1
End Sub
Note that pretty much every object has a Select method, so if you do want to explicitly select something, you can. In some cases, you may need to change the active window's view type first - so for example, you can't select a shape on a slide while in slide-sorter view.