oshp.TextFrame.TextRange.Font <The specified error is out of range>

ghumdinger · #1 10-20-2011, 08:25 AM

Hi all,

I'm trying to change all the text in a pptx (using Office 2010) to Times New Roman 24 pt. I'm not good with code. I found this on http://www.pptalchemy.co.uk/vbasamples.html :

But I got an out of range error: oshp.TextFrame.TextRange.Font <The specified error is out of range>.

Can someone help me? Thanks!

Regards,
Jay

Code:

Sub allchange()
Dim osld As Slide, oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
'Title text change values as required
If oshp.PlaceholderFormat.Type = 1 Or oshp.PlaceholderFormat.Type = 3 Then
With oshp.TextFrame.TextRange.Font
.Name = "Times New Roman"
.Size = 24
.Color.RGB = RGB(0, 0, 255)
.Bold = msoFalse
.Italic = msoFalse
.Shadow = False
End With
End If
If oshp.PlaceholderFormat.Type = 2 Or oshp.PlaceholderFormat.Type = 7 Then
'Body text change values as required
With oshp.TextFrame.TextRange.Font
.Name = "Times New Roman (Body)"
.Size = 24
.Color.RGB = RGB(0, 0, 255)
.Bold = msoFalse
.Italic = msoFalse
.Shadow = False
End With
End If
End If
Next oshp
Next osld
End Sub

PetLahev · #2 10-21-2011, 03:45 AM

Try this one

ONLY SAMPLE

Code:

If shp.HasTextFrame Then
   If shp.TextFrame.HasText Then
       With shp.TextFrame.TextRange.Font
              .Size = 24
              .Name = "Times New Roman"
       End With
   End If
End If

ghumdinger · #3 10-22-2011, 12:46 AM

Hi, thanks.

I got an "object expected", error 424 error for this line:

If shp.HasTextFrame Then

Best wishes,
Jay

PetLahev · #4 10-22-2011, 02:02 AM

here you are the whole code

Code:

Sub allchange()
    
    Dim osld As Slide, oshp As Shape
    
    
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.Type = msoPlaceholder Then
            
                'Title text change values as required
                If oshp.PlaceholderFormat.Type = 1 Or oshp.PlaceholderFormat.Type = 3 Then
                    If oshp.HasTextFrame Then
                        If oshp.TextFrame.HasText Then
                            With oshp.TextFrame.TextRange.Font
                                .Name = "Times New Roman"
                                .Size = 24
                                .Color.RGB = RGB(0, 0, 255)
                                .Bold = msoFalse
                                .Italic = msoFalse
                                .Shadow = False
                            End With
                        End If
                    End If
                End If
            
                If oshp.PlaceholderFormat.Type = 2 Or oshp.PlaceholderFormat.Type = 7 Then
                    'Body text change values as required
                    
                    If oshp.HasTextFrame Then
                        If oshp.TextFrame.HasText Then
                            With oshp.TextFrame.TextRange.Font
                                .Name = "Times New Roman (Body)"
                                .Size = 24
                                .Color.RGB = RGB(0, 0, 255)
                                .Bold = msoFalse
                                .Italic = msoFalse
                                .Shadow = False
                            End With
                        End If
                    End If
                    
                End If
            End If
        Next oshp
    Next osld
    
End Sub

ghumdinger · #5 10-22-2011, 02:28 AM

Awesome. Worked like a charm.

Thanks & have a great weekend!

JohnWilson · #6 12-09-2011, 10:36 PM

Pet

Thanks for pointing out the need to check for TextFrame & Text, I've modifed the original code with a credit!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Can't delete range - error 5904	expatriate	Word VBA	1	06-03-2011 12:12 AM
Runtime error 5487 - Word cannot complete the save to to file permission error	franferns	Word	0	11-25-2009 05:35 AM
Receive error cannot open this form because an error occurred in BCM 2007	bornhusker	Outlook	0	06-01-2009 10:28 AM
Subscript out of range error	KHTAY	Excel	6	03-28-2009 11:18 PM
Mysterious "Subscript out of range" error	rnstewart	Excel	4	12-29-2005 01:04 PM