Зажечь "Звезду" в Exl

[Терминатор]

Вернее зажечь я её зажег, но как ПРАВИЛЬНО. ?
Понятное дело, Exl не для анимаций, то же самое в Фотошопе я делаю за 20 минут, и потом лепи куда хочешь. Да и в инете полно готовых анимашек. Но русский, он не дурак, гору обходить не будет. Мы лёгких путей не выбираем.
Короче, горит то она горит, но код написал я интуитивно, так как я делалбы настоящую анимашку. Получилось нечто ужасное.
Но вопрос не только в том как правильно обращаться к Shapes, но и в том, чтоб Звезда именно "горела." Использование короткого цикла For Next результата не дал.
Наверное лучше один раз увидеть, чтоб понять что я хочу, и вообще о чём я. Так что посмотрите.
Кстати на втором Листе, надпись "Терминатор", c нем я тоже решил побаловаться. Вроде всё хорошо, но не так как хотелось бы. В этот раз наоборот, код получился грамотный, да вот эффект немного не дотягивает до нужного уровня. Но я там прям на листе и написал. Прочтёте
Спасибо.

[GSerg]

Прочтём. Аттач как найдём - сразу прочтём...

[Терминатор]

Ха, а где файл-то мой ?
Интересно и куда же, а самое главное к кому он отправился. Ладно пробую ещё раз.
Посмотрим куда на этот раз он приатачится.
Надеюсь теперь его будет видно.

[GSerg]

Таки-нет?

[alibek]

Попробуй после выбора файла нажать кнопку "Добавить приложение", прежде чем отправлять сообщение.

[Терминатор]

Не ребята, я так не играю...
Отдайте мне мои игрушки...
Третий раз пробовать не буду, а то наверное смеяться будите.

Может это у нас на работе, СисАдмин какие-нибудь новшества ввёл, ведь инет у нас через его сеть идёт. Незнаю.
Но вот это уже сработало. Проверил. Качайте.
просто введите в стороку адрес -
webfile.ru/246590

[RayShade]

LOL

[Терминатор]

http://www.webfile.ru/246590

[Димитрий]

А так?

Код: Выделить всё

With ActiveSheet
.Shapes("1").Visible = True
.Shapes("2").Visible = True
.Shapes("3").Visible = True
.Shapes("4").Visible = True
.Shapes("5").Visible = True
.Shapes("6").Visible = True
.Shapes("7").Visible = True
k = 1
Do
    .Shapes(CStr(k)).Select
    Selection.ShapeRange.ZOrder msoBringToFront
    k = k + 1
    If k = 8 Then k = 1
    DoEvents
Loop
End With

[GSerg]

Гы

Насчёт надписи могу предположить, что дёргается и будет дёргаться Можно попробовать ослабить дёрганье выравниванием 3D-глубины с обоих краёв, потому что с правого глубже...

Насчёт звёзд попробуй так:

Код: Выделить всё

Option Explicit

Private Type SColors
  ForeColor As Long
  BackColor As Long
  LineColor As Long
End Type

Private Sub CommandButton1_Click()
  ActiveSheet.Shapes("1").Visible = True
End Sub

Private Sub CommandButton2_Click()
  Dim Colors(1 To 7) As SColors, i As Long, Start As Single
 
  Const PauseTime As Single = 0.3
 
  Colors(1).ForeColor = &H99FF&
  Colors(1).BackColor = &HFFFFFF
  Colors(1).LineColor = &HFFFFFF
 
  Colors(2).ForeColor = &HFF&
  Colors(2).BackColor = &HFFFFFF
  Colors(2).LineColor = &HFFFFFF
 
  Colors(3).ForeColor = &HFF&
  Colors(3).BackColor = &HCCFFFF
  Colors(3).LineColor = &HFFFF&
 
  Colors(4).ForeColor = &HFF&
  Colors(4).BackColor = &HFFFF&
  Colors(4).LineColor = &HFF&
 
  Colors(5).ForeColor = &HFF&
  Colors(5).BackColor = &H99FF&
  Colors(5).LineColor = &HFFFFFF
 
  Colors(6).ForeColor = &HFF&
  Colors(6).BackColor = &HFFFFFF
  Colors(6).LineColor = &HFFFFFF
 
  Colors(7).ForeColor = &H99FFFF
  Colors(7).BackColor = &HFFFFFF
  Colors(7).LineColor = &H99FFFF
 
  Do
    For i = LBound(Colors) To UBound(Colors)
      Me.Shapes("1").Fill.ForeColor.RGB = Colors(i).ForeColor
      Me.Shapes("1").Fill.BackColor.RGB = Colors(i).BackColor
      Me.Shapes("1").Line.ForeColor.RGB = Colors(i).LineColor
      DoEvents
     
      Start = Timer + PauseTime
      Do While Timer < Start
        DoEvents
      Loop
    Next
  Loop
End Sub

Private Sub Worksheet_Activate()
  ActiveSheet.Shapes("1").Visible = True
End Sub

[Терминатор]

Вау !
Да, по поводу надписи я тоже так думал, по крайней мере в Exl. Я VB ещё хуже знаю, но как в нём подобное вращять можно? Или там также будет этот эффект "вздрагивания" ?

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