版块 › CorelDRAW专区 › 复制和对齐，名码，可以拿去耍耍

next 发表于 2025-3-17 20:57:01

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

本帖最后由 next 于 2025-3-17 21:00 编辑


几个复制和对齐的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 发表于 2025-3-17 21:02:30

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

xiaoshenren 发表于 2025-3-18 08:37:54

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

旅途印象 发表于 2025-3-19 08:38:22

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

查看完整版本: 复制和对齐，名码，可以拿去耍耍