Find and replace text, and only changed the Scale

[pithe]

My code:

Sub Szöveg_csere()
ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrCenter
Dim s As Shape, n As Long, sr As ShapeRange
Dim x As Double, y As Double, w As Double, h As Double
Set sr = ActiveSelection.Shapes.FindShapes(, cdrTextShape)
For Each s In sr

s.Text.Replace "TEXT1", "TEXT2TEXT2", True, ReplaceAll:=True
'every selected text resize, but not only TEXT1
s.GetPosition x, y
s.GetSize w, h
s.SetSizeEx x, y, 111, h

Next s

End Sub

Please Help!

[runflacruiser]

Hi.
You're looking for shapes in the active selection. Are you sure you have something selected?
If you want to process all shapes then use:

Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)

-John

[pithe]

Here is the text of all resize. I would like to have only exchanged text resize.
Attached test file.

[runflacruiser]

Hi.
Try the get and set bounding box but you have to get the size first before you change it:

Sub Szöveg_csere()

ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrCenter
Dim s As Shape, n As Long, sr As ShapeRange
Dim x As Double, y As Double, w As Double, h As Double

Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)
For Each s In sr
    s.GetBoundingBox x, y, w, h
    s.Text.Replace "TEXT1", "TEXT2TEXT2", True, ReplaceAll:=True
    s.SetBoundingBox x, y, w, h

Next s

End Sub

-John

[pithe]

This solution would be good if the same size as the original, but if I can resize the text then you have to implement all of the text. How to achieve it, only that the search / replace text, do the scaling?

[runflacruiser]

Hi.
I thing this is what you mean:

Sub Szöveg_csere()

ActiveDocument.Unit = cdrMillimeter
ActiveDocument.ReferencePoint = cdrCenter
Dim s As Shape, n As Long, sr As ShapeRange
Dim x As Double, y As Double, w As Double, h As Double

Set sr = ActivePage.Shapes.FindShapes(, cdrTextShape)
For Each s In sr
    If s.Text.Story.Characters.All = "TEXT1" Then
        s.GetBoundingBox x, y, w, h
        s.Text.Replace "TEXT1", "TEXT2TEXT2", True, ReplaceAll:=True
        s.SetBoundingBox x, y, w, h
    End If

Next s

-John

[pithe]

It will be so good. The Bounding Boxes referencepoint how to change?
ActiveDocument.ReferencePoint = cdrCenter is NOT.
s.SetBoundingBox x, y, 110, h,, cdrCenter is NOT.

Center text aligment is s.SetBoundingBox x, y, 110, h,, cdrCenter
bottomleft and I think the reference point. How to select reference point?

[runflacruiser]

Hi.
I'm not 100% clear on what you mean but...
You would have to calculate the center like

x + w/2

-John

[pithe]

Thanks for your help!
Now we have solved the problem with your help. I am very thankful for it!