在用户窗体上循环更新图表图像
Loop Updating Chart Image on Userform
好的,
所以我尝试集成以下代码:
`Private Sub UserForm_Initialize()
Dim Fname As String
Call SaveChart
Fname = ThisWorkbook.Path & "\temp1.gif"
Me.Image1.Picture = LoadPicture(Fname)
End Sub
Private Sub SaveChart()
Dim MyChart As Chart
Dim Fname As String
Set MyChart = Sheets("Data").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
End Sub`
from this post: 到一个现有的循环中,这样上面的代码段就会随着循环迭代,每次循环执行时都会更新图像。我会 post 编辑它作为对上述问题的评论,但我没有足够的代表。
'
' Get last logged data
'
Private Sub GetLastLoggedData()
Dim rangeToWrite
Dim lStartFileSize As Long
Dim lNextFileSize As Long
Dim dtStartTime As Date
Dim lElapsedTime As Long
Dim bDone As Boolean
Dim sLastHeader As String
Dim sLastData As String
Dim iCol As Integer
Dim sNextValue As String
Dim iLoop As Integer
Dim Fname As String
Dim MyChart As Chart
On Error GoTo ErrorHandler
' Initialize global_bHasScanCount flag
global_bHasScanCount = False
' Get the file size of the log file
lStartFileSize = FileLen(global_sLogFile)
' Initialize timer
dtStartTime = Now
' Wait for filesize to change
UpdateLogStatus Now & " : Data Monitor: waiting for file size to change..."
bDone = False
Do
' Get the file size of the log file and see if it's changed
lNextFileSize = FileLen(global_sLogFile)
If lNextFileSize <> lStartFileSize And lNextFileSize <> 0 Then
bDone = True
Else
lElapsedTime = DateDiff("s", dtStartTime, Now)
If (lElapsedTime >= global_lTimeout) Or (lElapsedTime < 0) Then
bDone = True
End If
End If
DoEvents
Loop Until bDone = True
' Backup the file
UpdateLogStatus Now & " : Data Monitor: backing up data file..."
'FileCopy global_sLogFile, global_sLogFileBackup
' Read the log file
UpdateLogStatus Now & " : Data Monitor: reading data file..."
sLastData = ""
sLastHeader = ""
If ReadLogFile(global_sLogFile, sLastData, sLastHeader) = False Then
' Delete the backup log file
'Kill global_sLogFileBackup
Exit Sub
End If
' Delete the backup log file
'Kill global_sLogFileBackup
UpdateLogStatus Now & " : Data Monitor: updating worksheet..."
' Clear previous Results in Excel Spreadsheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Range("A2:IV2").ClearContents
' Parse comma delimeted header and place data into worksheet cells. If we have the scan count then
' start writing in column1, else starting writing in column2.
If global_bHasScanCount = True Then
iCol = 1
Else
iCol = 2
End If
If sLastHeader <> "" Then
' Clear previous Results in Excel Spreadsheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Range("A1:IV1").ClearContents
Do
sNextValue = GetToken(sLastHeader, ",")
' Copy Results to Excel worksheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Cells(1, iCol).Value = sNextValue
iCol = iCol + 1
Loop Until sLastHeader = ""
End If
' Parse comma delimeted results and place data into worksheet cells. If we have the scan count then
' start writing in column1, else starting writing in column2.
If global_bHasScanCount = True Then
iCol = 1
Else
iCol = 2
End If
Do
sNextValue = GetToken(sLastData, ",")
' Copy Results to Excel worksheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Cells(2, iCol).Value = sNextValue
iCol = iCol + 1
'Copy Current Data to Control Panel
UserForm2.TextBox2.Text = Sheets("ACQUIRE DATA").Range("B12")
'Copy Time to Control Panel
UserForm2.TextBox3 = Format(Sheets("ACQUIRE DATA").Range("B13"), "hh:mm:ss")
'Copy Speed to Control Panel
UserForm2.TextBox4.Text = Sheets("ACQUIRE DATA").Range("B14")
'create .gif file of current PerfMap chart
Set MyChart = Sheets("PerfMap").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
Fname = ThisWorkbook.Path & "\temp1.gif"
'set live data chart image to most recent image
UserForm3.Image1.Picture = LoadPicture(Fname)
Loop Until sLastData = ""
UpdateLogStatus ""
Exit Sub
ErrorHandler:
BuildErrorMessage "GetLastLoggedData", "Failed to get last logged data."
UpdateLogStatus ""
End Sub'
但是,每当我这样做时,我都会收到错误处理程序生成的运行时错误 1004。非常感谢任何关于为什么这不起作用的帮助。
编辑:离开 24 小时后,我意识到有问题的 sheet 是图表 sheet,而不是嵌入式图表,因此我在上面尝试使用的方法不起作用。
该图表位于名为 PerfMap 的图表 sheet 上,但图表名称为图表 7。
下面的代码解决了我的问题。
'create .gif file of current PerfMap chart
Set PerfMap = Charts("PerfMap")
Fname = ThisWorkbook.Path & "\temp1.bmp"
PerfMap.Export Filename:=Fname, FilterName:="BMP"
'set live data chart image to most recent image
UserForm3.Image1.Picture = LoadPicture(Fname)
根据此 MSDN https://support.microsoft.com/en-us/kb/175918 必须使用 BMP 才能使图片正常工作。
现在我的新问题是上面的代码使我的循环变慢,随着时间的推移,我最终使用了 99% 的系统内存,直到我退出 excel 并重新打开它。
好的,
所以我尝试集成以下代码:
`Private Sub UserForm_Initialize()
Dim Fname As String
Call SaveChart
Fname = ThisWorkbook.Path & "\temp1.gif"
Me.Image1.Picture = LoadPicture(Fname)
End Sub
Private Sub SaveChart()
Dim MyChart As Chart
Dim Fname As String
Set MyChart = Sheets("Data").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
End Sub`
from this post:
'
' Get last logged data
'
Private Sub GetLastLoggedData()
Dim rangeToWrite
Dim lStartFileSize As Long
Dim lNextFileSize As Long
Dim dtStartTime As Date
Dim lElapsedTime As Long
Dim bDone As Boolean
Dim sLastHeader As String
Dim sLastData As String
Dim iCol As Integer
Dim sNextValue As String
Dim iLoop As Integer
Dim Fname As String
Dim MyChart As Chart
On Error GoTo ErrorHandler
' Initialize global_bHasScanCount flag
global_bHasScanCount = False
' Get the file size of the log file
lStartFileSize = FileLen(global_sLogFile)
' Initialize timer
dtStartTime = Now
' Wait for filesize to change
UpdateLogStatus Now & " : Data Monitor: waiting for file size to change..."
bDone = False
Do
' Get the file size of the log file and see if it's changed
lNextFileSize = FileLen(global_sLogFile)
If lNextFileSize <> lStartFileSize And lNextFileSize <> 0 Then
bDone = True
Else
lElapsedTime = DateDiff("s", dtStartTime, Now)
If (lElapsedTime >= global_lTimeout) Or (lElapsedTime < 0) Then
bDone = True
End If
End If
DoEvents
Loop Until bDone = True
' Backup the file
UpdateLogStatus Now & " : Data Monitor: backing up data file..."
'FileCopy global_sLogFile, global_sLogFileBackup
' Read the log file
UpdateLogStatus Now & " : Data Monitor: reading data file..."
sLastData = ""
sLastHeader = ""
If ReadLogFile(global_sLogFile, sLastData, sLastHeader) = False Then
' Delete the backup log file
'Kill global_sLogFileBackup
Exit Sub
End If
' Delete the backup log file
'Kill global_sLogFileBackup
UpdateLogStatus Now & " : Data Monitor: updating worksheet..."
' Clear previous Results in Excel Spreadsheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Range("A2:IV2").ClearContents
' Parse comma delimeted header and place data into worksheet cells. If we have the scan count then
' start writing in column1, else starting writing in column2.
If global_bHasScanCount = True Then
iCol = 1
Else
iCol = 2
End If
If sLastHeader <> "" Then
' Clear previous Results in Excel Spreadsheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Range("A1:IV1").ClearContents
Do
sNextValue = GetToken(sLastHeader, ",")
' Copy Results to Excel worksheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Cells(1, iCol).Value = sNextValue
iCol = iCol + 1
Loop Until sLastHeader = ""
End If
' Parse comma delimeted results and place data into worksheet cells. If we have the scan count then
' start writing in column1, else starting writing in column2.
If global_bHasScanCount = True Then
iCol = 1
Else
iCol = 2
End If
Do
sNextValue = GetToken(sLastData, ",")
' Copy Results to Excel worksheet
ThisWorkbook.Worksheets("ACQUIRE DATA").Cells(2, iCol).Value = sNextValue
iCol = iCol + 1
'Copy Current Data to Control Panel
UserForm2.TextBox2.Text = Sheets("ACQUIRE DATA").Range("B12")
'Copy Time to Control Panel
UserForm2.TextBox3 = Format(Sheets("ACQUIRE DATA").Range("B13"), "hh:mm:ss")
'Copy Speed to Control Panel
UserForm2.TextBox4.Text = Sheets("ACQUIRE DATA").Range("B14")
'create .gif file of current PerfMap chart
Set MyChart = Sheets("PerfMap").ChartObjects(1).Chart
Fname = ThisWorkbook.Path & "\temp1.gif"
MyChart.Export Filename:=Fname, FilterName:="GIF"
Fname = ThisWorkbook.Path & "\temp1.gif"
'set live data chart image to most recent image
UserForm3.Image1.Picture = LoadPicture(Fname)
Loop Until sLastData = ""
UpdateLogStatus ""
Exit Sub
ErrorHandler:
BuildErrorMessage "GetLastLoggedData", "Failed to get last logged data."
UpdateLogStatus ""
End Sub'
但是,每当我这样做时,我都会收到错误处理程序生成的运行时错误 1004。非常感谢任何关于为什么这不起作用的帮助。
编辑:离开 24 小时后,我意识到有问题的 sheet 是图表 sheet,而不是嵌入式图表,因此我在上面尝试使用的方法不起作用。
该图表位于名为 PerfMap 的图表 sheet 上,但图表名称为图表 7。
下面的代码解决了我的问题。
'create .gif file of current PerfMap chart
Set PerfMap = Charts("PerfMap")
Fname = ThisWorkbook.Path & "\temp1.bmp"
PerfMap.Export Filename:=Fname, FilterName:="BMP"
'set live data chart image to most recent image
UserForm3.Image1.Picture = LoadPicture(Fname)
根据此 MSDN https://support.microsoft.com/en-us/kb/175918 必须使用 BMP 才能使图片正常工作。
现在我的新问题是上面的代码使我的循环变慢,随着时间的推移,我最终使用了 99% 的系统内存,直到我退出 excel 并重新打开它。