Vba code to replace with chr(13) with space for selected text in powerpoint

shoun2502

New Member
Joined
Nov 14, 2018
Messages
43
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Dear all,

I am currently working on this code and I need to replace chr(13) with space for the selected text and not for the whole slide. The code below works well with all shapes in active presentation .

The code is as follows :



Code:
Sub Removepb()
Dim otxR As TextRange
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Not oshp.Type = msoPlaceholder Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set otxR = oshp.TextFrame.TextRange
otxR.Text = Replace(otxR.Text, Chr(13), "")
End If
End If
End If
Next oshp
Next osld
End Sub

The suggestions would be welcome to customize this subroutine to run on the selected Text inside a shape.

Regards
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Select a shape containing text and run the code

Code:
Sub ReplaceText()
    Dim Shp As Shape
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
        If Shp.HasTextFrame Then
            With Shp.TextFrame.TextRange
                .Text = Replace(.Text, Chr(10), "") 
            End With
            Exit For
        End If
    Next Shp
    If Err.Number > 0 Then MsgBox "no shape selected"
End Sub


Notes
.Text = Replace(.Text, Chr(10), "")
- your original code which you said does exactly what you want

On Error Resume Next

- prevents the code failing if run when nothing selected
 
Last edited:
Upvote 0
Hi yongle,

I have used your subroutine with slight modificactions as mentioned below

Code:
Sub ReplaceText()
    Dim Shp As Shape
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
        If Shp.HasTextFrame Then
            With Shp.TextFrame.TextRange
                .Text = Replace(.Text, Chr(13), "")
            End With
            Exit For
        End If
    Next Shp
    If Err.Number > 0 Then MsgBox "no shape selected"
End Sub

But the issue it is replacing all text in the shape rather than the selected text.

Please help if you could check that.


Thanks for your reply
 
Upvote 0
Here you go
- select a single block of text within a shape and run the code

Code:
Sub ReplaceSelectedText()
    Dim Shp As Shape, Pos As Long, LenSelTxt As Long, lenShpTxt As Long
    Dim SelTxt As String, shpTxt As String, leftTxt As String, rightTxt As String
    
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
[COLOR=#006400][I]    'selected text[/I][/COLOR]
        SelTxt = ActiveWindow.Selection.TextRange
        LenSelTxt = Len(SelTxt)
[I][COLOR=#006400]    'shape text[/COLOR][/I]
        shpTxt = Shp.TextFrame.TextRange.Text
        lenShpTxt = Len(shpTxt)
 [COLOR=#006400][I]   'to left and right of selected text[/I][/COLOR]
        Pos = InStr(1, shpTxt, SelTxt, vbTextCompare)
        leftTxt = Left(shpTxt, Pos - 1)
        rightTxt = Right(shpTxt, lenShpTxt - Pos - LenSelTxt + 1)
 [I][COLOR=#006400]   'replace text and reassemble[/COLOR][/I]
        SelTxt = Replace(SelTxt, Chr(10), " ")
        shpTxt = leftTxt & SelTxt & rightTxt
        Shp.TextFrame.TextRange.Text = shpTxt
        Exit For
    Next Shp
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top