Эксель 2007 SmartArt - Microsoft Office Excel - Страница 2

g-alex-nik · 09.07.2011, 01:54

R Dmitry Благодарю тебя за подсказку. Твое выражение я еще посмотрю (Логика?!.... она где то рядом.), просто занимался макросом. А теперь окончательный вариант для тех, кому интересно. Работает замечательно.

Sub SmartArt() ' смело изменил название макроса
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
Range("C1:C150").ClearContents
For i = 1 To ActiveSheet.Shapes.Count
If Cells(i, 1) = 1 Then ActiveSheet.Shapes("Полилиния " & i).Fill.ForeColor.RGB = iColor&
Next
Application.ScreenUpdating = True
End Sub

Еще раз благодарю всех.

g-alex-nik · 09.07.2011, 02:27

Еще раз большое спасибо всем за подсказку. Работает замечательно. А теперь я помещаю окончательный вариант для тех, кому это интересно.

Sub SmartArt() ' смело изменил название макроса
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 = 1 To ActiveSheet.Shapes.Count
If Cells(i, 1) = 1 Then ActiveSheet.Shapes("Полилиния " & i).Fill.ForeColor.RGB = iColor&
Next
Application.ScreenUpdating = True
End Sub

Еще раз благодарю Всех.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
бд эксель	sp@ker	БД в Delphi	4	16.04.2011 17:05
Эксель 2007: Проблема с запуском макроса по событию	Byroad	Microsoft Office Excel	7	14.09.2010 13:23
Эксель 2007. сводная таблица	Катик7	Microsoft Office Excel	1	13.05.2009 22:38

09.07.2011, 01:54	#11
g-alex-nik Регистрация: 08.07.2011 Сообщений: 6	R Dmitry Благодарю тебя за подсказку. Твое выражение я еще посмотрю (Логика?!.... она где то рядом.), просто занимался макросом. А теперь окончательный вариант для тех, кому интересно. Работает замечательно. Sub SmartArt() ' смело изменил название макроса 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 Range("C1:C150").ClearContents For i = 1 To ActiveSheet.Shapes.Count If Cells(i, 1) = 1 Then ActiveSheet.Shapes("Полилиния " & i).Fill.ForeColor.RGB = iColor& Next Application.ScreenUpdating = True End Sub Еще раз благодарю всех.

09.07.2011, 02:27	#12
g-alex-nik Регистрация: 08.07.2011 Сообщений: 6	Еще раз большое спасибо всем за подсказку. Работает замечательно. А теперь я помещаю окончательный вариант для тех, кому это интересно. Sub SmartArt() ' смело изменил название макроса 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 = 1 To ActiveSheet.Shapes.Count If Cells(i, 1) = 1 Then ActiveSheet.Shapes("Полилиния " & i).Fill.ForeColor.RGB = iColor& Next Application.ScreenUpdating = True End Sub Еще раз благодарю Всех.