Question

底部的完整代码 所以在回答了我自己关于在用户表单上创建实时图表图像的问题之后，请看这里：Loop Updating Chart Image on Userform，我现在不得不问另一个问题，为什么前三行代码会导致我消耗掉所有的代码在约7分钟的过程中可用ram，这个循环每分钟迭代大约12次？

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)

    'attempt to stop massive memleak in  above code
    Set PerfMap = Nothing
    Kill Fname

当这些代码行被注释掉时，无论循环运行多长时间，循环都能快速高效地运行，内存使用量也是恒定的。这已经意外地进行了3天或更长时间。正如您在下面看到的三行代码，我试图通过卸载负责的变量（PerfMap和Fname）来修复它，但无济于事。

提前感谢您提供的任何帮助。

修改1：添加了完整代码。仅在关闭Excel时释放内存。

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 PerfMap As Chart

    Fname = ThisWorkbook.Path & "\temp1.bmp"


    '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 (added 2/9/16 by KAK)
        UserForm2.TextBox3 = Format(Sheets("ACQUIRE DATA").Range("B13"), "hh:mm:ss")
        'Copy Speed to Control Panel (added 2/9/16 by KAK)
        UserForm2.TextBox4.Text = Sheets("ACQUIRE DATA").Range("B14")

   'create .bmp 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)

    'attempt to stop massive memleak with above code
    Set PerfMap = Nothing
    'Kill Fname


    Loop Until sLastData = ""
    UpdateLogStatus ""

'Added by Travis
'    ThisWorkbook.Worksheets("Comp GAS PROP").Range("B56:B63").Copy
'    ThisWorkbook.Worksheets("Comp Pt 10").Range("D51").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'    Application.CutCopyMode = False
'
'    ThisWorkbook.Worksheets("ACQUIRE DATA").Range("B56:B65").Copy
'    ThisWorkbook.Worksheets("Real Time").Range("D51").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'    Application.CutCopyMode = False
'    ThisWorkbook.Worksheets("ACQUIRE DATA").Range("B11:B51").Copy
'    ThisWorkbook.Worksheets("Real Time").Range("K5:K45").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'    Application.CutCopyMode = False
'End of Added

    Exit Sub

ErrorHandler:
    BuildErrorMessage "GetLastLoggedData", "Failed to get last logged data."
    UpdateLogStatus ""



End Sub

Answer 1

据我所知，BMP是一种可以在任何平台上使用的大型格式，为什么不尝试使用PNG呢？如果您担心图片质量，请尝试以下方法：

'This sorts out the quality by making the pasted image larger before exporting.  Change the value from 3 to whatever you like. 1 will not improve quality, 10 will make the output filesize huge.
With ActiveSheet
.Shapes("PerfMap").ScaleWidth 3, msoFalse, msoScaleFromTopLeft
.Shapes("PerfMap").ScaleHeight 3, msoFalse, msoScaleFromTopLeft
End With

'You can export to any image format here.  Ensure the file extension matches the filtername.
ActiveChart.Export Filename:=fName, filtername:="PNG"

Excel VBA循环消耗所有内存

1 个答案: