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

shoun2502

New Member
Joined
Nov 14, 2018
Messages
35
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
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,363
Office Version
365
Platform
Windows
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:

shoun2502

New Member
Joined
Nov 14, 2018
Messages
35
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,363
Office Version
365
Platform
Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,363
Office Version
365
Platform
Windows
Thanks for the feedback
(y)
 

Watch MrExcel Video

Forum statistics

Threads
1,102,674
Messages
5,488,210
Members
407,633
Latest member
varunwalla

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top