运行宏时更新动态图表 - Excel中的动画图表

Question

我有一个动态图表，根据单元格值更新每小时数据。该单元格由滚动按钮控制或在另一个单元格中手动输入日期。请查看下面的gif以获得洞察力;

我想要做的是使用VBA更新图表，使其像动画一样。让我们在下面有这个（伪）代码;

Option Explicit

#If VBA7 And Win64 Then
    '64 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#Else
    '32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If

Sub Animate()

On Error GoTo Error ErrorHandler    

Dim wsh As Worksheet
Dim i As Integer

Set wsh = ThisWorkbook.Worksheets("AChart")   
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

For i = 1 to 3000
    Sleep 50
    wsh.Range("K4").Value = i
    DoEvents
    Application.Wait Now() + TimeSerial(0, 0, 1)
Next i

Exit Sub
ErrorHandler:
MsgBox Err.Description & " Procedure Animated Graph"

End Sub

这（特别是DoEvents）不会在屏幕上更新图表。我想知道是否有办法实现这一点。

Answer 1

Application.OnTime 可用于此目的。其他内容（例如DoEvents或Sleep）仍会运行宏，并且会阻止图表更新（在屏幕上）。

如何制作动态图表？

首先，为了完成，这是一个如何制作动态图表的链接：

<强> Dynamic Excel Charts

在这里，您将学习引用单元格并使用偏移（或类似方法）来更改图表上显示的数据。

如何自动更改图表？

下面的代码是我早期尝试更新图表数据的自动化之一（所谓的＆＃34;动画＆＃34;）。工作表中Start和Finish是两个Command Buttons，用户可以控制＆＃34;动态图表＆＃34;被他们。您可以根据需要随意播放Pause等，但这可以为您提供有关如何实现此功能的原始想法：

Public laststop As Boolean
Public i As Integer

Sub start()
    laststop = True 'This controls schedule in Application.Ontime

    i = 1 'Reset the date to the first entry each time you press start
    Call Animate 'calls the main sub
End Sub

Sub finish()
    laststop = False 'Set the schedule to false to stop the macro
End Sub

'XXXXXXXXXXXXXXXXXXXX
'XXX MAIN PROGRAM XXX
'XXXXXXXXXXXXXXXXXXXX

Sub Animate()

On Error GoTo ErrorHandler

Application.OnTime Now() + TimeSerial(0, 0, 2), "Animate", Schedule:=laststop

If Not laststop Then GoTo nextline

Dim wsh As Worksheet

Set wsh = ThisWorkbook.Worksheets("Dynamic_Graph")
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

wsh.Range("I34").Value = i + 1
DoEvents

i = i + 1

If i > 200 Then laststop = False 'last data entry


Exit Sub

ErrorHandler:

   'Sometimes after running the finish macro these errors are happening that _
   'we don't want users to see them as they don't affect the process

If Err.Description = "The specified dimension is not valid for the current chart type" _
Or Err.Description = "Method 'OnTime' of object '_Application' failed" _ 
Then GoTo nextline

MsgBox Err.Description & " #Procedure: Animated Graph"

nextline:
         laststop = False

End Sub

感谢@A.S.H建议OnTime。

Answer 2

我有一个更简单的方法，恕我直言。像M-M一样，我使用“偏移”引用建立了一个表，因此我只需要更改一个单元格（AI1，我称之为控制单元格）即可将正确的数据输入到条形图中。问题在于，除非认为图形发生变化，否则图形不会更新。所以...每次我进行更改时，我都会将GapWidth重置为相同的值。 （这是条形图的参数。）

' This creates the sleep function, leave it as it is
#If VBA7 And Win64 Then
    '64 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#Else
    '32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If

'this is my macro
Sub RunAnimation()
    Sheets("Sheet1").Select
   Application.ScreenUpdating = True
   Range("AI1").Select 'this 
    For i = 1 To 24
        Sleep 1000 'milliseconds
        ActiveCell.FormulaR1C1 = i 'update the value in my control cell
        ActiveSheet.ChartObjects("Chart 1").Activate 'chart 1 is the object's name
        ActiveChart.ChartGroups(1).GapWidth = 93
        Range("AI1").Select 'i go back to my control cell to deselected the chart
    Next i
End Sub

在运行此功能之前，应将屏幕放置在所需的位置。控制单元应该在屏幕上。 （将文本设置为白色以使其不可见。）这不是一个聪明的脚本。如果您有多个图表，则必须分别对ActiveSheet ...和ActiveChart ...行执行操作。如果您不知道图表的名称，则记录一个宏，然后单击每个宏以获取它们。 您可以使用 Application.Wait（Now + TimeValue（“ 00:00:01”））代替 sleep 1000 ，然后就不需要第一部分了。但是我不知道你能否做到几分之一秒。