Как создать контур для группы фигур в Excel - PullRequest
Новая
       46

Как создать контур для группы фигур в Excel

0 голосов
/ 24 мая 2019

У меня есть несколько произвольных форм, которые я сформировал в группу.Теперь я хочу, чтобы цвет заливки и контура фигуры для всех произвольных форм группы изменялся в зависимости от значения ячейки.Это я смог сделать с помощью кода ниже.Однако внешний контур формы всей группы всегда должен оставаться черным, что не касается моего кода.В Интернете я нашел некоторый код, который мог бы пойти в этом направлении, но я не совсем понимаю его, и он не работает в моем файле (кажется, работает только для прямоугольных форм).Любая помощь очень ценится.

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

Код, который я получил до сих пор: 

Sub Region_Portugal()
Dim shp As Shape
Dim rg As Range
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Set rg = Sheet9.Range("N37")
Set rg1 = Sheet9.Range("I9")
Set rg2 = Sheet9.Range("I10")
Set rg3 = Sheet9.Range("I11")

If rg <= rg1 Then
    For Each shp In Sheet7.Shapes.Range(Array("Group 83"))
        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 0, 0)
        shp.Line.ForeColor.RGB = RGB(255, 0, 0)
    Next


ElseIf rg > rg1 And rg <= rg2 Then
    For Each shp In Sheet7.Shapes.Range(Array("Group 83"))
        shp.Fill.ForeColor.RGB = RGB(255, 165, 0)
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 165, 0)
        shp.Line.ForeColor.RGB = RGB(255, 165, 0)
    Next


ElseIf rg > rg2 And rg <= rg3 Then
    For Each shp In Sheet7.Shapes.Range(Array("Group 83"))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 0)
        shp.Line.ForeColor.RGB = RGB(255, 255, 0)
    Next


ElseIf rg > rg3 Then
    For Each shp In Sheet7.Shapes.Range(Array("Group 83"))
        shp.Fill.ForeColor.RGB = RGB(0, 255, 0)
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 0)
        shp.Line.ForeColor.RGB = RGB(0, 255, 0)
    Next

Else
    For Each shp In Sheet7.Shapes.Range(Array("Group 83"))
        shp.Fill.ForeColor.RGB = RGB(192, 192, 192)
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(192, 192, 192)
        shp.Line.ForeColor.RGB = RGB(192, 192, 192)
    Next
    End If

End Sub

Код, который я нашел в интернете: 

Sub AddBorderToGroup()
Dim oShRng As ShapeRange
Dim oSl As Slide
Set oShRng = ActiveWindow.Selection.ShapeRange

Set oSl = oShRng.Parent
With oSl

    With .Shapes.AddShape(msoShapeRectangle, _
        oShRng.Left, oShRng.Top, oShRng.Width, oShRng.Height)

        .Fill.Visible = False
        .Line.Visible = True
        .Line.Weight = 2 ' points
        ' etc for other line properties

    End With
End With

End Sub

Окончательным результатом будет карта Пиренейского полуострова, где разные регионы Испании и Португалии окрашены по-разному в зависимости от значений в ячейках.Карта, которую я использую в качестве шаблона, состоит из произвольных форм для каждого сервиса.Поэтому мне нужно объединить разные провинции, чтобы получить более крупные регионы.регионы должны иметь черную границу, чтобы вы могли различать их в случае, если есть несколько областей рядом друг с другом, имеющих одинаковый цвет.

...