Add text to textbox macro - vba

Why doesn't this code work to add text to textbox? I am sure the syntax is off somewhere, but not sure where.
Label5.Text = "Add Text"
Thanks.

Impossible to say w/o a more extensive bit of code.
If the text box is actually an ActiveX Label (as suggested by its name), then like so:
Sub thing()
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.ShapeRange(1)
oSh.OLEFormat.Object.Caption = "Some text"
End Sub
If it's a normal text box or other shape that can contain text:
Sub thing()
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.ShapeRange(1)
oSh.TextFrame.TextRange.Text = "Some text"
End Sub

Its because its a shape. Get the shapes collection and locate the label then access the TextFrame2.TextRange.text

Related

How to check if all TextBoxes in a PowerPoint document are filled in

I have a PowerPoint document where users can input text into several TextBoxes, over 6 slides in total.
On the last slide, I want to check if the user has filled in every TextBox in the presentation.
I tried using lots of code snippets on the internet and modifying them, however I am a complete VBA noob and, surprisingly, it did not work out. :')
I would greatly appreciate your help with this task.
It would be even better if it is possible to check whether the user has input AT LEAST 4 characters in each textbox. However I have no idea how to start programming this...
Here is my code, it does not show errors however nothing happens when clicking the CheckBox at the end.
Public Sub CheckTextBox()
Dim fTextBox As Object
For Each Slide In ActivePresentation.Slides
For Each fTextBox In ActivePresentation.Slides
If TypeName(fTextBox) = "TextBox" Then
If fTextBox.Text = "" Then
MsgBox "Please make sure to fill out all fields!"
End If
End If
Next
Next
End Sub
'When ticking this CheckBox, the MsgBox should show up
Private Sub CheckBox1_Click()
CheckTextBox
End Sub
Thank you guys so much for your help.
Your inner For-loop is wrong, you need to loop over all Shapes of the slide, instead, you start another loop over all slides.
Basically, all objects that you place on a slide are Shapes. If you use TypeName, you will get Shape. To distinguish the single shape-types, use the property type of the shape-object. A list of types can be found at https://learn.microsoft.com/de-de/office/vba/api/office.msoshapetype - a textbox has a type msoTextBox (17).
To get the text of a shape, use the property TextFrame.TextRange.Text of the shape.
Try the following code (it checks already for a length of at least 4 characters). It will stop at the first textbox that has less than 4 chars in it (else, you would get one MsgBox for every textbox) and select it.
Public Sub CheckTextBox()
Dim sh As Shape, slide As slide
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Debug.Print TypeName(sh)
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < 4 Then
MsgBox "Please make sure to fill out all fields!"
slide.Select
sh.Select
Exit For
End If
End If
Next
Next
End Sub
UPDATE
The code above didn't take into account the shapes within groups. The following code loops over all shapes of all slides and calls the function checkShape that will check
a) If the shape is a textBox (msoTextBox, 17) - if yes, the length of the text is checked and if too short, that shape is returned.
b) If the shape is a group (msoGroup, 6), it calls (recursively) the function for all child shapes and returns the first child textbox found.
The main routine (CheckAllTextBoxes) checks if any textBox was found, and, if yes, will select it and issue the message.
Public Sub CheckAllTextBoxes()
Dim slide As slide, sh As Shape
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Dim textBox As Shape
Set textBox = CheckShape(sh, 4)
If Not textBox Is Nothing Then
slide.Select
textBox.Select
MsgBox "Please make sure to fill out all fields!"
Exit Sub
End If
Next
Next
End Sub
Function CheckShape(sh As Shape, minLen As Integer) As Shape
' Check if shape is a Textbox and then text is not long enough
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < minLen Then
Set CheckShape = sh
Exit Function
End If
End If
' For a group, check all it's child shapes
If sh.Type = msoGroup Then
Dim child As Shape
For Each child In sh.GroupItems
Dim textBox As Shape
Set textBox = CheckShape(child, minLen)
If Not textBox Is Nothing Then
' Found a Textbox within the group, return it
Set CheckShape = textBox
Exit Function
End If
Next child
End If
End Function
For those looking for c# code to list all text boxes in a presentation:
using Microsoft.Office.Interop.PowerPoint;
using MsoShapeType = Microsoft.Office.Core.MsoShapeType;
public static IEnumerable<Shape> AllTextBoxes (Presentation presentation) =>
from slide in presentation.Slides.Cast<Slide>()
from shape in slide.Shapes.Cast<Shape>()
from textBox in AllTextBoxes(shape)
select textBox;
public static IEnumerable<Shape> AllTextBoxes (Shape sh)
{
IEnumerable<Shape> _() { if (sh.Type == MsoShapeType.msoTextBox) yield return sh; }
return sh.Type == MsoShapeType.msoGroup ? sh.GroupItems.Cast<Shape>().SelectMany(AllTextBoxes) : _();
}

Trying to find a shape with one fontname and replace its font to another

I wrote a code to ask user input a fontname and then use VBA to search the whole presentation for shapes that bears this font and replace to another.
However, my code somehow doesn't work.
I figure the reason is this line "If sh.TextFrame.TextRange.Font.Name = searchFont Then" The fontname return from the user input is just text, but this line need it to be within " ". (eg. "Arial")
if anyone has a solution to this, please kindly help me.
Thanks in advance
Sub ReplaceFont()
Dim sld As Slide
Dim sh As Shape
Dim searchFont As String
searchFont = InputBox("Please enter font to search.", "Font Search Function")
On Error Resume Next
For Each sld In ActivePresentation.Slides
For Each sh In sld.Shapes
If sh.HasTextFrame = True Then
If sh.TextFrame.HasText = True Then
If Ucase(sh.TextFrame.TextRange.Font.Name) = Ucase(searchFont) Then
With sh.TextFrame.TextRange.Font
.Name = "Arial"
End With
End If
End If
End If
Next
Next
End Sub

vba powerpoint select a slide by name

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).

Powerpoint 2007 - Possible to change placeholder to Title placeholder?

I've found after I've created several PowerPoint templates that I forgot to add the "Title" placeholder that you can find in Master View. Instead, I've added textbox placeholders instead, which works fine. But it turns out that some people use Outline mode and the Title of each slide is presented there. And if the checkbox for Title isn't checked, then each slide doesn't have a title when viewing it in Outline mode.
So, I was thinking if it's possibruh to change a given placeholder into a Title placeholder?
Maybe using VBA. Paste in Visual Basic. Select the targeted placeholder/textbox (any text).
Then, run it.
Sub convertToTitle()
Dim osld As Slide
Dim SlideIndex As Long
Dim oshp As Shape
Dim oTxR As TextRange
SlideIndex = ActiveWindow.View.Slide.SlideIndex
Set osld = ActivePresentation.Slides(SlideIndex)
Set oshp = ActiveWindow.Selection.ShapeRange(1)
Set osld = oshp.Parent
Set oTxR = oshp.TextFrame.TextRange
With ActivePresentation
ActivePresentation.Slides(SlideIndex).CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(2)
'use layout = 2 because it has both Title & Content
'but you can use any layout as long as it has Title in it
osld.Shapes.Placeholders.Item(1).TextFrame.TextRange = oTxR.Characters
oshp.Delete
End With
End Sub
Voila, it changes to Title Placeholder. But you have to run it for every slide.

Apply Font Formatting to PowerPoint Text Programmatically

I am trying to use VBA to insert some text into a PowerPoint TextRange, I use something like this:
ActiveWindow.Selection.SlideRange.Shapes("rec1").TextFrame.TextRange.Text = "Hi"
However, I can't figure out how to apply bold, italic and underline programmatically (I don't see a .RichText property or something similar).
What I have is some simple HTML text with bold, italic and underlined text I would like to convert over.
How to do this?
This is easily accomplished by using the TextRange's Characters, Words, Sentences, Runs and Paragraphs objects and then it's Font object to set Bold, Underline and Italic (amongst other properties). For example:
Sub setTextDetails()
Dim tr As TextRange
Set tr = ActiveWindow.Selection.SlideRange.Shapes(1).TextFrame.TextRange
With tr
.Text = "Hi There Buddy!"
.Words(1).Font.Bold = msoTrue
.Runs(1).Font.Italic = msoTrue
.Paragraphs(1).Font.Underline = msoTrue
End With
End Sub
Try looking at MSDN's documentation on the TextRange object. It contains samples of how to access the Font properties of the TextRange object.
EDIT: You can access things like Bold and Italics programmatically in this manner:
TextRange.Font.Bold = msoTrue
EDIT EDIT: There are several methods by which you can select only certain text in a text range. See the following:
Characters Method
Lines Method
Paragraphs Method
Words Method
According to the sames from this link, you can select a portion of the text using one of these methods and set the font programmatically. For example:
Application.ActiveDocument.Pages(1).Shapes(2) _
.TextFrame.TextRange.Words(Start:=2, Length:=3) _
.Font.Bold = True
That example was taken from the Words Method link.
In addition to the above answer, you should try to name the objects you'll be changing, since selecting them in the middle of a presentation could make PowerPoint act oddly. Create a new TextRange object and set it like this.
dim mytextrange As TextRange
Set mytextrange = ActiveDocument.Pages(1).Shapes(2).TextFrame.TextRange
mytextrange.Words...
Here is how you can do it to change the font of a specific text:
Sub changeFont()
Dim oPresentation As Presentation
Dim oSlide As Slide
Dim oShape As Shape
Dim stringSearched As String
stringSearched = "something"
'all opened presentations
For Each oPresentation In Presentations
'all slide in them
For Each oSlide In oPresentation.Slides
'all shapes (anything)
For Each oShape In oSlide.Shapes
'only those that contain text
If oShape.HasTextFrame Then
If InStr(oShape.TextFrame.TextRange.Text, stringSearched) > 0 Then
'here you need to define where the text ends and start
oShape.TextFrame.TextRange.Characters(InStr(oShape.TextFrame.TextRange.Text, stringSearched), Len(stringSearched)).Font.Underline = msoTrue
oShape.TextFrame.TextRange.Characters(InStr(oShape.TextFrame.TextRange.Text, stringSearched), Len(stringSearched)).Font.Italic = msoFalse
End If
End If
Next
Next
Next
End Sub