why format text is changed ???

[baset]

Dear all

I'm using this simple macro to replace double spaces but when i run it the text format is changed ash shown on the screen shots:

Sub ReplaceText()
Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim strFind As String, strReplace As String
Set oSld = ActiveWindow.View.Slide
strFind = Space$(2)
strReplace = Space$(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
While InStr(oTxtRng.Text, strFind) > 0
oTxtRng = Replace(oTxtRng, strFind, strReplace)
Wend
End If
Next oShp
End Sub


111.jpg

222.jpg

[baset]

I noticed that the reason is that there are 2 different text formats on the same box; Any Help ?

[baset]

Any news our VBA experts ?

[John Wilson]

You are replacing the whole textrange so it will take on the format of the start. You need to work on each run (new format)

This is top of my head but should at least get you started.

Sub ReplaceText()Dim oSld As Slide
Dim oShp As Shape
Dim oTxtRng As TextRange
Dim lngRun As Long
Dim strFind As String, strReplace As String
Set oSld = ActiveWindow.View.Slide
strFind = Space$(2)
strReplace = Space$(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
For lngRun = 1 To oShp.TextFrame.TextRange.Runs.Count ' each run
Set oTxtRng = oShp.TextFrame.TextRange.Runs(lngRun)
While InStr(oTxtRng.Text, strFind) > 0
oTxtRng = Replace(oTxtRng, strFind, strReplace)
Wend
Next lngRun
End If
Next oShp
End Sub

[baset]

You are KING Mr. John

[baset]

Dear John

How can i merge the below macro with that one you did ?

Set regX = CreateObject("vbscript.regexp")
With regX
.Global = False
.Pattern = "([0-9])\.([0-9])"
End With
For i = 1 To 10
strInput = oShp.TextFrame.TextRange.Text
b_found = regX.Test(strInput)
If b_found = True Then
strInput = regX.Replace(strInput, "$1,$2")
oShp.TextFrame.TextRange = strInput
End If
Next i

[John Wilson]

That looks a lot like me coding already - I recognise my style.

This is the last thing for a while I have paid work to do!

Sub ReplaceText()
Dim oSld As Slide
Dim oShp As Shape
Dim strinput As String
Dim oTxtRng As TextRange
Dim strFind As String, strReplace As String
Dim regX As Object
Set regX = CreateObject("vbscript.regexp")
With regX
.Global = False
.Pattern = "([0-9])\.([0-9])"
End With
Set oSld = ActiveWindow.View.Slide
strFind = Space$(2)
strReplace = Space$(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
While InStr(oTxtRng.Text, strFind) > 0
oTxtRng = Replace(oTxtRng, strFind, strReplace)
Wend
End If
strinput = oShp.TextFrame.TextRange.Text
b_found = regX.Test(strinput)
If b_found = True Then
strinput = regX.Replace(strinput, "$1,$2")
oShp.TextFrame.TextRange = strinput
End If

Next oShp
End Sub

[baset]

That looks a lot like me coding already - I recognise my style.

This is the last thing for a while I have paid work to do!

Sub ReplaceText()
Dim oSld As Slide
Dim oShp As Shape
Dim strinput As String
Dim oTxtRng As TextRange
Dim strFind As String, strReplace As String
Dim regX As Object
Set regX = CreateObject("vbscript.regexp")
With regX
.Global = False
.Pattern = "([0-9])\.([0-9])"
End With
Set oSld = ActiveWindow.View.Slide
strFind = Space$(2)
strReplace = Space$(1)
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
Set oTxtRng = oShp.TextFrame.TextRange
While InStr(oTxtRng.Text, strFind) > 0
oTxtRng = Replace(oTxtRng, strFind, strReplace)
Wend
End If
strinput = oShp.TextFrame.TextRange.Text
b_found = regX.Test(strinput)
If b_found = True Then
strinput = regX.Replace(strinput, "$1,$2")
oShp.TextFrame.TextRange = strinput
End If

Next oShp
End Sub

Dear John

You merged the 2 macros but used the whole text range so the format still changed; I'm asking you how can i merge the 2 replaces macros and used the Runs.count approach ??

[John Wilson]

Yes it wass an oversight but all you have to do is copy paste the appropriate section from the original code. Doing and learning is Good!

[baset]

Forgive me john; what will be the runs count parameter here:

Sub use_regex() 
    Dim regX As Object 
    Dim osld As Slide 
    Dim oshp As Shape 
    Dim strInput As String 
    Dim b_found As Boolean 
   
     
    Set regX = CreateObject("vbscript.regexp") 
    With regX 
        .Global = True 
        .Pattern = "(\d)\,(\d)" 
    End With 
    For Each osld In ActivePresentation.Slides 
        For Each oshp In osld.Shapes 
            
                If oshp.HasTextFrame Then 
                    If oshp.TextFrame.HasText Then 
                        strInput = oshp.TextFrame.TextRange.Text 
                        b_found = regX.Test(strInput) 
                        If b_found = True Then 
                            strInput = regX.Replace(strInput, "$1.$2") 
                            oshp.TextFrame.TextRange = strInput 
                        End If 
                    
                End If 
            End If 
        Next oshp 
    Next osld 
    Set regX = Nothing 
End Sub

[baset]

Dear John

really i tried a lot but i'm not VBA expert like you; all what i need is to use the replace to be per each run for replacing the numbers using Regular Expressions.

Plz help me

[John Wilson]

Let's see what you tried to work with runs. (Not what you lifted straight from my website!)
Have a look at the original code and then alter the regex part to look at each run.

Sub ReplaceText()    Dim oSld As Slide
    Dim oShp As Shape
    Dim strinput As String
    Dim oTxtRng As TextRange
    Dim strFind As String, strReplace As String
    Dim regX As Object
    Set regX = CreateObject("vbscript.regexp")
    With regX
        .Global = False
        .Pattern = "([0-9])\.([0-9])"
    End With
    Set oSld = ActiveWindow.View.Slide
    strFind = Space$(2)
    strReplace = Space$(1)
    For Each oShp In oSld.Shapes
        If oShp.HasTextFrame Then
            For lngRun = 1 To oShp.TextFrame.TextRange.Runs.Count ' each run
                Set oTxtRng = oShp.TextFrame.TextRange.Runs(lngRun)
                While InStr(oTxtRng.Text, strFind) > 0
                    oTxtRng = Replace(oTxtRng, strFind, strReplace)
                Wend
            Next lngRun
        End If
        ' count runs here
        strinput = oShp.TextFrame.TextRange.Text ' change this
        b_found = regX.Test(strinput)
        If b_found = True Then
            strinput = regX.Replace(strinput, "$1,$2")
            oShp.TextFrame.TextRange = strinput ' change this
        End If
         'next run
    Next oShp
End Sub

[baset]

This is supposed to be the right code but still didn't work:

' count runs here
Set oTxtRng = oShp.TextFrame.TextRange
For lngRun = 1 To oTxtRng.Runs.Count

strinput = oTxtRng.Runs(lngRun).Text ' change this
b_found = regX.Test(strinput)
If b_found = True Then
strinput = regX.Replace(strinput, "$1,$2")
oTxtRng = strinput ' change this
End If
'next run
Next lngRun

[John Wilson]

You need to also change here:

oTxtRng = strinput ' change this

TO

oTxtRng.Runs(lngRun) = strinput ' change this

[baset]

In English: You are the MASTER
In Arabic: إنت معلم