#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Code Help

The code below is supposed to create a simple animation
of an area filling up over time. It works when I 'single-
step' through it, but under normal execution, nothing is
displayed no matter how long the delay is set for until
the code execution is complete.

Can anyone help?

'== Box Fill ==
Const cFillBarX As Single = 50
Const cFillBarY As Single = 50
Const cGrad_Lines As Single = 20
Const OS1 As Single = 5
Const OS2 As Single = 20
'''
Dim Grad_Lines(1 To cGrad_Lines) As Shape
Dim LGrad_Lines(1 To cGrad_Lines) As LineFormat

Dim A, B, W, C, D, H, I, J As Single
'''

Sub Vert_FillBar_Animate()

Dim CurrentSheet As Worksheet
Dim WS As Worksheet
Set WS = ActiveSheet

' Gradiant Lines - Horizontal

For I = 1 To OS2 - 1

ActiveSheet.Cells(11, 2) = I

A = cFillBarX: B = cFillBarY - I
C = A + OS1: D = B
Set Grad_Lines(I) = WS.Shapes.AddLine(beginx:=A, _
beginy:=B, endx:=C, endy:=D)
Set LGrad_Lines(I) = Grad_Lines(I).Line
Grad_Lines(I).Name = "Grads" & I
LGrad_Lines(I).ForeColor.RGB = RGB(0, 0, 255)
LGrad_Lines(I).Weight = 2
Short_Del
Next I

ActiveSheet.Cells(11, 2) = ""
End Sub


Sub Clear_Lines()

Dim CurrentSheet As Worksheet
Dim WS As Worksheet
Set WS = ActiveSheet

On Error Resume Next
For J = 1 To cGrad_Lines
With WS.Shapes
.Item("Grads" & J).Delete
End With
Next J
On Error GoTo 0
End Sub


Sub Short_Del()

Dim CT As Double

CT = Timer + 0.5 'Del
Do While Timer < CT
Loop

End Sub



  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 27,285
Default Code Help

put in
DoEvents

immediately after the update.

make sure you don't have screenupdating turned off.

--
Regards,
Tom Ogilvy

"Johnb3" wrote in message
...
The code below is supposed to create a simple animation
of an area filling up over time. It works when I 'single-
step' through it, but under normal execution, nothing is
displayed no matter how long the delay is set for until
the code execution is complete.

Can anyone help?

'== Box Fill ==
Const cFillBarX As Single = 50
Const cFillBarY As Single = 50
Const cGrad_Lines As Single = 20
Const OS1 As Single = 5
Const OS2 As Single = 20
'''
Dim Grad_Lines(1 To cGrad_Lines) As Shape
Dim LGrad_Lines(1 To cGrad_Lines) As LineFormat

Dim A, B, W, C, D, H, I, J As Single
'''

Sub Vert_FillBar_Animate()

Dim CurrentSheet As Worksheet
Dim WS As Worksheet
Set WS = ActiveSheet

' Gradiant Lines - Horizontal

For I = 1 To OS2 - 1

ActiveSheet.Cells(11, 2) = I

A = cFillBarX: B = cFillBarY - I
C = A + OS1: D = B
Set Grad_Lines(I) = WS.Shapes.AddLine(beginx:=A, _
beginy:=B, endx:=C, endy:=D)
Set LGrad_Lines(I) = Grad_Lines(I).Line
Grad_Lines(I).Name = "Grads" & I
LGrad_Lines(I).ForeColor.RGB = RGB(0, 0, 255)
LGrad_Lines(I).Weight = 2
Short_Del
Next I

ActiveSheet.Cells(11, 2) = ""
End Sub


Sub Clear_Lines()

Dim CurrentSheet As Worksheet
Dim WS As Worksheet
Set WS = ActiveSheet

On Error Resume Next
For J = 1 To cGrad_Lines
With WS.Shapes
.Item("Grads" & J).Delete
End With
Next J
On Error GoTo 0
End Sub


Sub Short_Del()

Dim CT As Double

CT = Timer + 0.5 'Del
Do While Timer < CT
Loop

End Sub





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Code to conditional format all black after date specified in code? wx4usa Excel Discussion (Misc queries) 3 December 26th 08 07:06 PM
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
Convert a Number Code to a Text Code Traye Excel Discussion (Misc queries) 3 April 6th 07 09:54 PM
copying vba code to a standard code module 1vagrowr Excel Discussion (Misc queries) 2 November 23rd 05 04:00 PM


All times are GMT +1. The time now is 10:29 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"