What are Shape.TextFrame and .TextRange in PowerPoing VBA? - vba

I am looking for information to help me better understand ".TextFrame" and ".TextRange" objects in PowerPoing VBA. Can anybody help? I have reviewed the stuff on MSDN and am just continually disappointed with the documentation there.

Shapes are the basic building blocks for PPT slides, masters, layouts, notes pages; everything on them is a shape.
Some shapes (lines for example) can't contain text. Those that can contain text have a TextFrame. If a Shape.TextFrame contains text, then you can use Shape.TextFrame.TextRange to get access to (set/read) the properties of all of the text in the TextFrame. Other methods also return a .TextRange that may be some subset of the text within the .TextFrame.
Simple example:
Sub DoSomethingUseless()
Dim oSh as Shape
Dim oSl as Slide
For Each oSl in ActivePresentation.Slides
For Each oSh in oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
Debug.Print oSh.TextFrame.TextRange.Text
End If
End If
Next ' Shape
Next ' Slide
End Sub

Related

Get list of fonts to which PowerPoint has access to and compare to user input

I want to create a macro to set the font for all textboxes throughout PowerPoint.
I have the code to set them but for error handling I need to make sure that the font entered by the user is valid and therefore I need the full collection of fonts that PowerPoint has installed.
Private Sub ChangeTextFont_Click()
Dim oSl As Slide
Dim oSh As Shape
Dim strFontName As String
Dim ValidFont As Font
strFontName = InputBox("Enter the name of the font to use for the text on the screens or press Cancel to keep the existing font.", "Enter Font Name")
If Trim(strFontName) = "" Then Exit Sub
'For Each ValidFont In <collection of all fonts powerpoint has> <-------- this is my issue
If strFontName = ValidFont Then
With ActivePresentation
For Each oSl In .Slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
If oSl.Name <> "Config" Then
.TextFrame.TextRange.Font.Name = strFontName
End If
End If
End If
End With
Next
Next
End With
End If
'Next
End Sub
Ideally, I need the solution to only use PowerPoint (not launching Word as this has different font selection) and not be too long as this isn't supposed to be a difficult problem.
So in the end this was easiest to do pulling the list from word. I thought the list was different but that was due to caching fonts in the document I was comparing. Anyway for a good solution please check out the answer on this question: Get a list of all fonts in VBA Excel 2010
You could try looking in the Microsoft Office\root\Office16\1033\PUBFTSCM\FONTSCHM.INI file in your install directory and then parse through that...
Not sure what kind of data in there would be helpful, but it's a start.

How can I replace a style in a presentation with another one?

I have a number of presentations where I show code examples. Each one is a lesson in a course.
I have not been very systematic: in some presentations I use the menlo style. In others I use consolas. I also sometimes mix both in the same presentation. Bad, bad me!
I now would like to make everything more consistent. Going through each and every slide in every presentation to change the style is my punishment.
But is there a way to make that change global ? I mean is there a way to replace a style globally in a presentation ? In multiple presentations ?
Here's a starter:
Option Explicit
' Edit these to reflect the names of the fonts
' you want to change from and to:
Const ChangeFromFont As String = "Consolas"
Const ChangeToFont As String = "Courier New"
Sub ChangeFontName()
Dim oSh As Shape
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
With oSh.TextFrame.TextRange
If UCase(.Font.Name) = UCase(ChangeFromFont) Then
.Font.Name = ChangeToFont
End If
End With
End If
End If
Next
Next
End Sub

Moving video on every slide in powerpoint

I'm just poking around in VBA with PowerPoint and know that what I want to do can be done. I just don't know the write calls/sytanx to use!
I want a macro that will run through all the slides in a presentation and move the video object to specific spot on the slide. The spot will be the same on all slides.
It would be very helpful if someone could show me how to do this! Or at least point me in the right direction. Thanks!
Here's what I found for doing something on every slide
Sub EveryTextBoxOnSlide()
' Performs some operation on every shape that contains text on every slide
' (doesn't affect charts, tables, etc)
Dim oSh As Shape
Dim oSl As Slide
On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
' If font size is mixed, don't touch the font size
If .TextFrame.TextRange.Font.Size > 0 Then
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size + 2
End If
End If
End If
End With
Next ' shape
Next ' slide
NormalExit:
Exit Sub
ErrorHandler:
Resume Next
End Sub
And this is something I found to move the object to desired location (here's where I don't know what to call the video object)
With ActiveWindow.Selection.ShapeRange
.Left = 640 'change the number for desired x position
.Top = 75 'change the number for desired y position
End With
End Sub
Sub ll()
End Sub
So basically, I want to run the last piece as a function of the first one instead of shapes with text. Does that make sense?
I've done some programming in the past, mainly with actionscript and Flash. I could probably write out some basic functions, just not sure how to run it in VBA without learning a whole new language. Which I don't want to do, since I'm an instructional designer and don't have the free time to learn it! :)
Here's a little function that'll return True if the shape you pass to it is a video, and a bit of example code to test it with:
Function IsVideo(oSh As Shape) As Boolean
If oSh.Type = msoMedia Then
If oSh.MediaType = ppMediaTypeMovie Then
IsVideo = True
Exit Function
End If
End If
' Things get a little trickier if the movie is in a placeholder
' Is it a placeholder? and is it a media object?
If oSh.Type = msoPlaceholder Then
If oSh.PlaceholderFormat.ContainedType = msoMedia Then
' it's a media object, but we don't know if it's
' a movie or sound or what, so we duplicate it
' then look at the duplicate (which is now a copy
' of the placeholder content but is not a placeholder itself)
With oSh.Duplicate
If .Type = msoMedia Then
If .MediaType = ppMediaTypeMovie Then
IsVideo = True
End If
End If
' and delete the duplicate
.Delete
End With
End If
End If
End Function
Sub thing()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If IsVideo(oSh) Then
oSh.Left = 0
End If
Next
Next
End Sub
Now you're getting somewhere!
I don't know what kind of shape holds your video, so this modification should help you identify it.
Sub EveryTextBoxOnSlide()
Dim oSh As Shape
Dim oSl As Slide
On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
.Select
End With
Next
Next
NormalExit:
Exit Sub
ErrorHandler:
Resume Next
End Sub
While there is no need whatsoever to use the .Select in your final code, this is only here to help you identify which shape actually holds the video. Put a breakpoint (F9) on that line and run your code (F5), then debug through it with F8 to execute one line at a time and run through your loop looking at each shape until you see that your video has been selected.
Once your video has been selected look at the various properties (using the Immediate Window of the IDE) of oSh until you find the uniqueness that identifies this is your video. (There may be some property about the content type of the shape, or a link on where to find the contents that contains the text string ".avi", ".mpg", ".flv", etc - there will be some sort of identifier you can find.)
Once you've identified what makes the shape the holder of a video, replace
.Select
with
If {my video containing shape criteria is true} Then
With .Selection.ShapeRange
.Left = 640 'change the number for desired x position
.Top = 75 'change the number for desired y position
End With
End If
Changing the values (as commented) to whatever it is that you need.
Important Note: It is very good that your sample code has some error handling built in, but all this error handler is doing is sweeping any errors under the rug. This particular handler is the very long form version of On Error Resume Next which does have its uses, but in very, very limited situations.
As you get your code working, you'll actually want to put something useful in the ErrorHandler: section, but that's the topic for a whole new question.
Ok, here is how I modified the code supplied above to do this in my case:
Sub EveryTextBoxOnSlide() ' Performs some operation on every shape that contains text on every slide ' (doesn't affect charts, tables, etc) Dim oSh As Shape Dim oSl As Slide On Error GoTo ErrorHandler
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
If .Type = msoMedia Then
If .MediaType = ppMediaTypeMovie Then
.PictureFormat.Crop.PictureHeight = 236
.PictureFormat.Crop.PictureWidth = 314.2115
.PictureFormat.Crop.PictureOffsetX = 8.737323
.PictureFormat.Crop.PictureOffsetY = 0
.PictureFormat.Crop.ShapeHeight = 236.3478
.PictureFormat.Crop.ShapeWidth = 163
.PictureFormat.Crop.ShapeLeft = 796.6956
.PictureFormat.Crop.ShapeTop = 0
End If
End If
End With
Next ' shape Next ' slide
NormalExit: Exit Sub
ErrorHandler: Resume Next
End Sub

VBA for Microsoft PowerPoint to recognize and hide text boxes in German language

I need to make two presentations with the same slides, backgrounds, and everything except for the text: one in German and one in English. Therefore I have two separate presentations which I must always simultaneously update, otherwise one language version will be outdated and I often forget what I changed.
I have made a custom show with all of the slides copied into one PowerPoint presentation and that works fairly well, but I still must change two of the same slides each time that I make an edit to one language.
Therefore, I'm trying to write a macro that will recognize all textboxes within the presentation with German text in them and hide them during the show, and vice versa. Then, each of the macros would be linked to a hyperlinked box on the title slide called 'English' or 'German' which, when clicked, would hide the textboxes in the other languages while also leaving all pictures and formatting the same. Ideally, the macro would hide all boxes in one language and make all the boxes in the other language visible again within the same step, so that the presentation is always usable and I don't have a user who opens a PPT with 'no text boxes' because they would all be hidden...
In order to achieve this I have two text boxes containing the text in both languages on the same slide, that's why I'd like to hide the textboxes.
I am able to get all text boxes hidden but not text boxes in a specific language (aka, all boxes regardless of their editing language will get hidden but not any specific ones).
PS - text boxes do not NEED to be referenced here... it could just refer to a shape. I was trying to avoid, that Pictures would be hidden and thought text boxes would be the best way to reference what I wanted.
Is there a better way?
I don't really know how to reference a language in VBA, I found this website by accident and thought someone might have a quick trick to help me out with this issue. The code I have which will blend out textboxes but not blend out specific language-boxes is as follows:
Sub GermanTextBoxFinder()
Dim SlideToCheck As Slide
Dim ShapeIndex As Integer
' Visit each slide
For Each SlideToCheck In ActivePresentation.Slides
' On each slide, count down through the shapes
For ShapeIndex = SlideToCheck.Shapes.Count To 1 Step -1
' If the shape IS a text box and DOES have German text
If SlideToCheck.Shapes(ShapeIndex).Type = msoTextBox And _
MsoLanguageID.msoLanguageIDGerman _
Then
' Toggle visibility of German Textboxes
SlideToCheck.Shapes(ShapeIndex).Visible = msoFalse
End If
Next
Next
End Sub
Why don't you name the shapes with German text something that identifies them? E.g. use the prefix "txtGER" for the texts in German and "txtENG" for the ones in English. Then you could use something like the following:
If SlideToCheck.Shapes(ShapeIndex).Type = msoTextBox And _
Left(SlideToCheck.Shapes(ShapeIndex).Name, 6) = "txtGER" Then
' Toggle visibility of German Textboxes
SlideToCheck.Shapes(ShapeIndex).Visible = msoFalse
Else
SlideToCheck.Shapes(ShapeIndex).Visible = msoTrue
End If
(Please see this q+a for information on how to rename the shapes).
This will hide text boxes/shapes with text that contain either English or French. You can modify HideFrench to hide German instead ... Intellisense will provide the correct constants.
Sub HideEnglish()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
If oSh.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS Then
oSh.Visible = False
Else
oSh.Visible = True
End If
End If
End If
Next
Next
End Sub
Sub HideFrench()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
If oSh.TextFrame.TextRange.LanguageID = msoLanguageIDFrench Then
oSh.Visible = False
Else
oSh.Visible = True
End If
End If
End If
Next
Next
End Sub

PowerPoint vba - For each shape in each Layout in MasterView

I'm trying to programatically change the language of each shape in each customlayout in a PowerPoint template and I can't figure out how to do this. I've done it before, but I can't find the macro anymore so I don't really know how I did it. I've been able to select each custom layout though. But I need to loop through each textbox in each layout and select the language as well. My problem is targetting each shape. How do I do this?
This is what I've got so far:
ActiveWindow.ViewType = ppViewSlideMaster
For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
oLayout.Select
Next
This basically loops through each layout. But I can't figure out how to select each placeholder? How do I do this?
Edit: Resolution is now:
For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
oLayout.Select
Dim oShape As Shape
For Each oShape In oLayout.Shapes
oShape.Select
Next
Next
Loop through oLayout.Shapes, or perhaps oLayout.Shapes.Placeholders.
Thanks you two. I needed a solution to updating an embedded Excel object on the master slide.
This lead me to the perfect solution
'loops through all shapes in slidemaster
Dim oShape As Shape
For Each oShape In ActivePresentation.SlideMaster.Shapes
oShape.Select
'checks for excel object (type=7)
If oShape.Type = msoEmbeddedOLEObject Then
oShape.OLEFormat.Activate
ActiveWindow.Selection.Unselect 'deactivates shape
End If
Next