Эксель 2007 SmartArt

[g-alex-nik]

Уважаемые программисты. Подскажите пожалуйста, как в Эксель 2007 программно в VBA массив рисунков SmartArt от 0 до 100 связать с диапазоном ячеек A1:A100. При запуске макроса значение в определённой ячейке окрашивала фигуру SmartArt в некоторый цвет, скажем ячейка А3 окрашивает фигуру 3, ячейка А5 окрашивает фигуру 5. У меня есть код для каждой отдельной фигуры, но я не могу организовать цикл. Подскажите пожалуйста, как это сделать.
С уважением Голяндин Александр.

[motorway]

Покажите ваш код, может, что-нибудь придумаем

[IgorGO]

for i = 1 to sheets(1).shapes.count
  sheets(1).shapes(i).color = ...
next

[motorway]

Но, кстати, если вставить стрелку с текстом, то она не поддерживает такое свойство Color при обращении к Shapes(1)

[IgorGO]

цикл по картинкам есть...
дальше автор сам может определить какого типа очередной Shapes и на какое свойство нажать, чтобы он принял правильный цвет
плюс этот цикл замечательно увязывается с ячейками А1, А2...

[g-alex-nik]

Мой код следующий Sub Макрос1()
'
' Макрос1 Макрос
'

'
Application.ScreenUpdating = False
Select Case [B2]
Case 1: iColor& = vbRed
Case 2: iColor& = vbBlue
Case 3: iColor& = vbCyan
Case 4: iColor& = vbGreen
Case 5: iColor& = vbYellow
Case 6: iColor& = vbMagenta
Case Else: iColor& = vbWhite
End Select
Select Case [A1]
Case 1:
Dim Shp As Shape
Set Shp = ActiveSheet.Shapes("Полилиния 1")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Select Case [A2]
Case 1:
Set Shp = ActiveSheet.Shapes("Полилиния 2")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Select Case [A3]
Case 1:
Set Shp = ActiveSheet.Shapes("Полилиния 3")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Select Case [A4]
Case 1:
Set Shp = ActiveSheet.Shapes("Полилиния 4")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Select Case [A5]
Case 1:
Set Shp = ActiveSheet.Shapes("Полилиния 5")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Select Case [A6]
Case 1:
Set Shp = ActiveSheet.Shapes("Полилиния 6")
Shp.Fill.ForeColor.RGB = iColor&
End Select
Range("C1:C150").Select
Selection.ClearContents
Range("C1").Select
Application.ScreenUpdating = True
End Sub

В диапазоне ячеек A1:A6, если мы подставляем в некоторые ячейки значение "1", а затем запускаем макрос, то соответствующие фигуры окрашиваются в тот цвет, который задан в ячейке В2. Проблема в организации цикла, так как для сотни фигур этот код будет громоздким.

[IgorGO]

так как для сотни фигур этот код будет громоздким

ничего пишите...
мы в Вас верим

у меня альтернативное предложение:

Sub Макрос2() ' смело изменил название макроса
  Application.ScreenUpdating = False
  Select Case [B2]
    Case 1: iColor& = vbRed
    Case 2: iColor& = vbBlue
    Case 3: iColor& = vbCyan 
    Case 4: iColor& = vbGreen
    Case 5: iColor& = vbYellow
    Case 6: iColor& = vbMagenta
    Case Else: iColor& = vbWhite
  End Select
  for i = i to activesheet.shapes.count
    ActiveSheet.Shapes(i).Fill.ForeColor.RGB = iColor&
  next
  Range("C1:C150").ClearContents
  Application.ScreenUpdating = True
End Sub

[g-alex-nik]

Спасибо за подсказку. Даже более того. Но проблема не устранилась. При запуске макроса окрашиваются все фигуры. А нужно, что бы окрашивались лишь те фигуры (Полилиния1, Полилиния4)например, в ячейках А1 и А4 стояло бы соответствующее значение или число. В вашем случае Массив С1:C150
Но в любом случае большое Вам спасибо.
С уважением Александр

[g-alex-nik]

Кстати. Я думаю, что кому - то может быть интересен макрос позволяющий определить цвет ячейки в "RBG" с последующей записью данных в соседние ячейки
Sub Определить_цвет()

Application.ScreenUpdating = False
Range(Cells(1, 4), Cells(1, 6)) = DECIMAL2RGB(ActiveCell.Interior.Col or)
ActiveCell.Offset(0, 1) = (Range("D1"))
ActiveCell.Offset(0, 2) = (Range("E1"))
ActiveCell.Offset(0, 3) = (Range("F1"))
Application.ScreenUpdating = True
End Sub
___________________________________ ______________________________
Function DECIMAL2RGB(ColorVal) As Variant

DECIMAL2RGB = Array(ColorVal \ 256 ^ 0 And 255, ColorVal \ 256 ^ 1 And 255, ColorVal \ 256 ^ 2 And 255)
End Function

Данный код помещают в стандартный модуль. Затем на активном листе выделяют ячейку, цвет которой нужно установить, запускают макрос и в ячейках справа записываются значения цвета.

[R Dmitry]

Сообщение от g-alex-nik

Спасибо за подсказку. Даже более того. Но проблема не устранилась. При запуске макроса окрашиваются все фигуры. А нужно, что бы окрашивались лишь те фигуры (Полилиния1, Полилиния4)например, в ячейках А1 и А4 стояло бы соответствующее значение или число. В вашем случае Массив С1:C150
Но в любом случае большое Вам спасибо.
С уважением Александр

 for i = 1 to activesheet.shapes.count
   if cells(i,1)=1 then ActiveSheet.Shapes(i).Fill.ForeColor.RGB = iColor&
  next

только не помню с какого индекса шейпы идут

или так

 for i =1 to activesheet.shapes.count
   if cells(i,1)=1 then ActiveSheet.Shapes("Полилиния " & i).Fill.ForeColor.RGB = iColor&
  next