如何通过VBA实现批量把文档内所有图形和组合文本框内的内容全部单倍行距

Zhanghaijing87

附件是一个原始文档。里面包含很多文本框和组合文本框图形。
因为图形里面的文字，好多都是多倍行距。
我想要vba实现文档内所有图形、文本框、组合文本框（包括悬浮和嵌入式）批量都是单倍行距。

针对本附件文档，录制的宏就三步选择图形单倍行距即可：
Sub 宏1()
'
' 宏1 宏
'
'
    ActiveDocument.Shapes.range(Array("Group 350")).Select
    Selection.ParagraphFormat.Space1
    ActiveDocument.Shapes.range(Array("Group 397")).Select
    Selection.ParagraphFormat.Space1
    ActiveDocument.Shapes.range(Array("Group 488")).Select
    Selection.ParagraphFormat.Space1
End Sub
但是我修改了半天也不行。请大佬帮忙看下如何写这个代码。
调整前：

调整后效果：