Можем ли мы изменить форму или цвет границы группы объектов следующим образом?

Question

Я сгруппировал некоторые формы в Excel. но я не вижу никакой возможности изменить цвет границы группы. когда я пытаюсь изменить цвет границы группы, вместо этого меняется цвет фигур внутри группы.

Я также пытался следовать VBA

shDesignFormat.DrawingObjects.Group
Selection.line.BorderColor = VbBlue

Любая помощь?

Answer 1

Я создал этот код для добавления прямоугольника под вашу группу:

Sub SubAddFrame(ObjGroup As Object)

    'Declarations.
    Dim ObjRectangle As Object
    Dim DblPlus As Double
    Dim StrRectangleName As String
    Dim WrsWorksheet As Worksheet

    'Checking if ObjGroup exist.
    If ObjGroup Is Nothing Then
        MsgBox "Group named " & ObjGroup.Name & " not found. The frame will not be added/edited.", vbCritical, "SubAddFrame - Error"
        Exit Sub
    End If

    'Setting variables.
    StrRectangleName = "ShpFrameFromSubroutine"
    DblPlus = 6
    Set WrsWorksheet = ObjGroup.Parent

    'Checking if a previous ObjRecangle has been created with this macro.
    On Error Resume Next
    If WrsWorksheet.Shapes(StrRectangleName) Is Nothing Then
        Set ObjRectangle = WrsWorksheet.Shapes.AddShape(msoShapeRectangle, 0, 0, 72, 72)
    Else
        Set ObjRectangle = WrsWorksheet.Shapes(StrRectangleName)
    End If
    On Error GoTo 0

    'Focusing ObjRectangle.
    With ObjRectangle
        'Filling it with grid.
        With .Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorBackground1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = -0.25
            .Patterned msoPatternDottedGrid
        End With
        'Setting the line.
        With .Line
            .Visible = msoTrue
            .Weight = 2
        End With
        'Placing it over the ObjGroup.
        .Height = ObjGroup.Height + DblPlus * 2
        .Width = ObjGroup.Width + DblPlus * 2
        .Left = ObjGroup.Left - DblPlus
        .Top = ObjGroup.Top - DblPlus
        'Setting its name.
        .Name = StrRectangleName
        'Pushing it back.
        .ZOrder msoSendToBack
    End With

End Sub

Он может быть вызван из другой подпрограммы. Вот пример, разработанный в соответствии с вашими дальнейшими инструкциями:

Sub AnyOfYourSub()

    '[You can place more of your code here]

    'Deleting "FrameFromSubroutine" (if it exists already).
    On Error Resume Next
    shDesignFormat.Shapes("ShpFrameFromSubroutine").Delete
    'Ungrouping any object (if any grouped).
    shDesignFormat.DrawingObjects.Ungroup
    On Error GoTo 0
    'Selection.ShapeRange.Ungroup
    Call SubAddFrame(shDesignFormat.DrawingObjects.group)

    '[You can place more of your code here]

End Sub