Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
split post code (zip code) out of cell that includes full address | Excel Discussion (Misc queries) | |||
Code to conditional format all black after date specified in code? | Excel Discussion (Misc queries) | |||
Drop Down/List w/Code and Definition, only code entered when selec | Excel Worksheet Functions | |||
Convert a Number Code to a Text Code | Excel Discussion (Misc queries) | |||
copying vba code to a standard code module | Excel Discussion (Misc queries) |