Изменение цвета группы фигур без выделения (заливка и текст)

#excel #excel-2010 #vba

Вопрос:

Что касается следующего кода:

 Sub Macro1 ()
   With ActiveSheet.Shapes.Range(Array("MyShapeGroup")) 
     .Fill.ForeColor.RGB = cPurp  ''cPurp is global constant
     .TextFrame.Characters.Font.ColorIndex = 2
   End With
End Sub

Я могу выполнить макрос только с изменением цвета заливки, однако, когда я добавляю изменение цвета текста, я получаю ошибку, определяемую приложением или объектом.

Итак, я попробовал это:

 Sub Macro1()
    With ActiveSheet.Shapes.Range(Array("MyShapeGroup")).ShapeRange
       .Fill.ForeColor.RGB = cPurp
       .TextFrame.Characters.Font.ColorIndex = 2
    End With
End Sub

Который выдает «Объект не поддерживает это свойство или метод» в With строке.

Также пробовал это:

 Sub Macro1()
    With ActiveSheet.Shapes.Range(Array("MyShapeGroup"))
       .Fill.ForeColor.RGB = cPurp
       .ShapeRange.TextFrame.Characters.Font.ColorIndex = 2
    End With
End Sub

Который выдает другой «Объект не поддерживает это свойство или метод» в .ShapeRange строке.

Также пробовал это:

 Sub Macro1 ()
    ActiveSheet.Shapes.Range(Array("MyShapeGroup")).Select
    With Selection.ShapeRange
        .Fill.ForeColor.RGB = cPurp ''cPurp is global constant
        .TextFrame.Characters.Font.ColorIndex = 2
    End With
End Sub

Как я могу эффективно выполнять как изменение цвета заливки, так и изменение цвета текста без использования выбора?

Обновленный рабочий метод (протестирован в Excel 2010 и Excel в Office365):

 Option Explicit

Sub test()
        With ActiveSheet.Shapes.Range(Array("MyShapeGroup"))
            .Fill.ForeColor.RGB = RGB(255, 255, 0)
            .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
        End With
End Sub

1. Как вы создали «MyShapeGroup»?

2. Поскольку вы находитесь в макросе, почему бы не перебрать массив фигур и не задать свойства 1×1???

3. @Raystafarian это название группы фигур, измененное по сравнению с тем, что было по умолчанию, вероятно, группа 1

Ответ №1:

Попробуйте использовать TextFrame2.TextRange свойство вместо:

 Option Explicit

Sub test()
    Dim shp As Shape
        For Each shp In ActiveSheet.Shapes.Range(Array("MyShapeGroup"))
            shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
            shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
        Next
End Sub

1. Я не думаю, что ваш код на самом деле перебирает каждую фигуру в группе, поэтому почему TextFrame это не сработает. Он перебирает один раз, где shp находится вся группа, и меняет цвета всех фигур одновременно. Для выполнения цикла массив должен быть настроен как (Array("Shape 1", "Shape 2")) etc. При циклическом просмотре отдельных фигур будет работать TextFrame или TextFrame2.

2. Еще один способ, позволяющий выполнить вышеуказанную работу: For Each shp In ActiveSheet.Shapes.Range(Array("MyShapeGroup")).GroupItems

3. Хм, да, это имеет смысл. Я действительно не тестировал эту часть.

Ответ №2:

Я не силен в VBA, но я думаю, что это сработало для меня!

 Sub test()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes("MyShapeGroup").GroupItems
        shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
        shp.TextFrame.Characters.Font.Color = vbWhite
    Next
End Sub