复制和对齐，名码，可以拿去耍耍

next

几个复制和对齐的vba东西，录制了下，再改了下值， 剩下的可
Sub 向下复制()
    ActiveDocument.unit = CDRCentimeter
    Dim nexthy As ShapeRange
    Set nexthy = ActiveSelectionRange
    Dim dup1 As ShapeRange
    Set dup1 = nexthy.StepAndRepeat(1, 0#, 0.5, 0, ModeY:=2)

End Sub
Sub 向右复制()
    ActiveDocument.unit = cdrCentimeter
    Dim nexthy As ShapeRange
    Set nexthy = ActiveSelectionRange
    Dim dup1 As ShapeRange
    Set dup1 = nexthy.StepAndRepeat(1, 0.5, 0#, 2, ModeY:=0)
End Sub
Sub 左侧对齐()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 2, 0, 0, 0, False, 2
End Sub
Sub 右侧对齐()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 1, 0, 0, 0, False, 2
End Sub
Sub 顶端对齐()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 0, 1, 0, 0, False, 2
End Sub
Sub 底边对齐()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 0, 2, 0, 0, False, 2
End Sub
Sub 水平居中()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 0, 3, 0, 0, False, 2
End Sub
Sub 垂直居中()
    Dim nexthy As Shape, os As ShapeRange
    Set nexthys = ActiveSelectionRange
    ActiveDocument.CreateShapeRangeFromArray(nexthys).AlignAndDistribute 3, 0, 0, 0, False, 2
End Sub

next

一个小时才能一发贴， 剩下的明天再说了，困高

xiaoshenren

直接粘贴可用，对代码不懂的我来说够用了 ，
等待窗体代码

旅途印象

不懂就问：是不是复制到记事本另存GMS格式的