小印 发表于 2024-10-15 10:25:37

求助,vba批量加框怎么让外框和对象群组

Sub ÅúÁ¿¼Ó¿ò()
    Dim S As Shape, s1 As Shape, sr As ShapeRange, s2 As ShapeRange
    ActiveDocument.Unit = cdrMillimeter
    Dim sx#, sy#, sw#, sh#
    Set sr = ActiveSelection.Shapes.All 'Ñ¡ÖеÄËùÓжÔÏó¸÷¼ÓÒ»¸ö¿ò
    For Each S In sr
      S.GetBoundingBox sx, sy, sw, sh
      Set s1 = ActiveLayer.CreateRectangle2(sx - 3, sy - 3, sw + 6, sh + 6)
            s1.Fill.ApplyNoFill
            s1.Outline.SetProperties 0.076
            s1.Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)
            s1.Outline.SetNoOutline
Next S
End Sub

好利伯 发表于 2024-10-15 10:52:04

https://www.52cnp.com/thread-18371-1-1.html

w2545 发表于 2024-10-16 12:37:50

本帖最后由 w2545 于 2024-10-16 12:40 编辑

Set s2 = ActivePage.SelectShapesFromRectangle(s1.LeftX, s1.TopY, s1.RightX , s1.BottomY , True)         
s2.group


试试这个行不

zg275822558 发表于 2024-10-16 16:43:48

小精灵就行 有批量
页: [1]
查看完整版本: 求助,vba批量加框怎么让外框和对象群组