AddLabel - как выполнить заливку?

AddLabel - как выполнить заливку?, что нужно добавить в макрос?

Пользователь

Сообщений: 3 Регистрация: 09.02.2013

09.02.2013 13:14:58

Доброго времени суток, нужна помощь. как с помощью VBA выполнить заливку красным цветом Shapes в эксель?

Sub zalivka()

Dim cur_range As Range
With ActiveSheet
Set cur_range = Selection
cur_range.Activate
'Worksheets("схема" ;) .Activate
For x = 1 To cur_range.Rows.Count

If cur_range(x, 2) <> "" Then Str_0 = Int(cur_range(x, 2) / 100)

Set myDocument = Worksheets("схема" ;)

If cur_range(x, 2) <> "" And cur_range(x, 3) <> "" Then myDocument.Shapes.AddLabel(msoTextOrientationHorizontal, cur_range(x, 2) * 10 - Str_0 * 1000, Str_0 * 120 + 30, cur_range(x, 3) * 10 - cur_range(x, 2) * 10, 30).TextFrame.Characters.Text = cur_range(x, 4)

Next x
End With

Изменено: Variant - 09.02.2013 23:54:30

Юрий М

Модератор

Сообщений: 61089 Регистрация: 14.09.2012

Контакты см. в профиле

09.02.2013 13:26:43

Для общего случая - заливаем автофигуру (прямоугольник 2) тем цветом, которым залита ячейка А1:

Код

Sub Test()
    Dim x As Shape
    Set x = ActiveSheet.Shapes("Rectangle 2")
    x.Fill.ForeColor.RGB = Range("A1").Interior.Color
End Sub

Variant Пользователь Сообщений: 3 Регистрация: 09.02.2013	#3 09.02.2013 13:45:57 Проблема в том что не знаю как именно в моем случае выполнить заливку, не обращаться, а сразу определенного цвета вставить на лист: myDocument.Shapes.AddLabel(msoTextOrientationHorizontal, 10, 10, 10, 30).TextFrame.Characters.Text = "проба"

Юрий М Модератор Сообщений: 61089 Регистрация: 14.09.2012 Контакты см. в профиле	#4 09.02.2013 14:04:50 Так и вставляйте, а затем .Fill.ForeColor.RGB

EducatedFool

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

09.02.2013 16:00:03

Цитата
не обращаться, а сразу определенного цвета вставить на лист

так не получится, чтобы одной строкой кода всё сделать.

Не экономьте буквы в коде - и все получится:

Код

with myDocument.Shapes.AddLabel(msoTextOrientationHorizontal, 10, 10, 10, 30)
  .TextFrame.Characters.Text = "проба"
  .Fill.ForeColor.RGB = Range("A1").Interior.Color
end with

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Variant Пользователь Сообщений: 3 Регистрация: 09.02.2013	#6 10.02.2013 15:28:37 спасибо, помогло )

Читают тему