A little help at the end of the Macro, please

In the video I show that I use two macros, the first one folds and leaves it at 90cm.

Sub Duplicar_90x90()

Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
Dim dup1 As ShapeRange
Set dup1 = OrigSelection.Duplicate(12.57195, 10.02878)
dup1.Move 32.57195, 10.02878
dup1.OrderToFront
Dim dup2 As ShapeRange
Set dup2 = dup1.Duplicate(, -22.81105)
dup2.Move 0#, -22.81105
dup2.OrderToFront
ActiveDocument.ReferencePoint = cdrCenter
dup1.Stretch 2.25
dup2.Stretch 2.25

End Sub

I need the bottom square to have its content reduced to 44.4%, I am doing this with another macro.

Sub Reducao_Percentual_444()

Dim OrigSelection As ShapeRange

Set OrigSelection = ActiveSelectionRange

ActiveDocument.ReferencePoint = cdrCenter

OrigSelection.Stretch 0.444

End Sub

I want this to be done with just one macro.