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


15179

15180

[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 ? :crying:

[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 :clap::clap::clap::clap:

[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 :crying::banghead:

[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: إنت معلم

:clap::clap::clap::clap::clap::clap::clap::clap: