通过 VBA 创建图表 - 内存不足，无法完成此操作

Question

我有一个 Excel 宏，可以为每一行创建自定义图表。

我打算每次运行宏时创建大约 50,000 个图表。在遇到错误之前，我只完成了大约 3,000 - 5,000：

"There isn't enough memory to complete this action. Try using less data or closing other applications. To increase memory availability, consider using a 64-bit version of Microsoft Excel."

一开始，代码大约每秒创建一个图表。当它达到数百然后数千时，它会大幅减慢。

在崩溃之前和崩溃期间，我可以从任务管理器中看到只有 10% 的 CPU 和 15% 的 RAM 被使用 - 远不及我认为导致这样的内存所必需的问题。

当我收到错误时，我通常会保存并关闭 Excel，重新打开工作簿，然后运行又好了。所以我输入了一些代码，每 1,000 个图表停止一次，然后在继续之前保存工作簿。那根本没有帮助。

关于我的系统和设置的一些注意事项：

我运行在具有 64 GB RAM 的专用 Windows 2016 服务器上安装此服务器（确切的服务器规格在此处：https://turnkeyinternet.net/dedicated-servers/dedicated-server-dual-hexacore-64gb/）
我是运行宁 64 位 Excel 2016
在我尝试运行这个宏时运行没有其他程序正在运行（除了其他必要的后台进程，当然还有 Outlook 会话）
我已禁用所有 COM 加载项、Excel 加载项和 Outlook 加载项
我将计算设置为手动

代码如下：

Sub CHARTS()

'Turning off non-essential functions
Application.ScreenUpdating = False
Application.DisplayStatusBar = False

'Counting how many rows of data in the Import sheet
' (corresponding to how many charts are generated)
Dim lngRow As Long
lngRow = Worksheets("Import").Cells(Rows.Count, "A").End(xlUp).Row

'Variables to operate the macro
Dim Counter As Integer

'Variables to sub into the template
Dim DataField1 As String
Dim DataField2 As String
Dim DataField3 As String
Dim Recipient As String

'Variables to create and copy the custom chart
Dim DataObj As Shape
Dim objChart As chart
Dim folderpath As String
Dim picname As String
Dim ws As Worksheet
Dim chart As Picture

'Variables to Find & Replace in the template
Dim strFind As String
Dim strNew As String
Dim imgSrc As String

'Data starts at row 2, below headers... Goes to the last row of the sheet
For Counter = 2 To lngRow

    'Pulls the values from their cells in the Import sheet
    DataField1 = Worksheets("Import").Cells(Counter, 24)
    DataField2 = Worksheets("Import").Cells(Counter, 1)
    DataField3 = Worksheets("Import").Cells(Counter, 5)
    Recipient = Worksheets("Import").Cells(Counter, 17)

    'Pastes the values from into the Chart sheet to create the custom chart
    Worksheets("Chart").Cells(1, 2) = DataField1
    Worksheets("Chart").Cells(2, 2) = DataField2
    Worksheets("Chart").Cells(6, 2) = DataField3

    'Updates the chart area, since calculation is set to manual mode
    Worksheets("Chart").Columns("A:J").Calculate

    Set ws = Worksheets("Chart")

    'Locating & assigning current folder path of Excel file,
    ' then setting the name for the chart image based on DataField1
    folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator
    picname = DataField1 & ".jpg"

    'Copying the chart range as an image
    ActiveWindow.DisplayGridlines = False
    On Error GoTo ErrHandler3:
    Call ws.Range("H6:AB26").CopyPicture(xlPrinter, xlPicture)

    'Creates a new sheet called Image, then adds the chart image,
    ' sets the height/width, then exports it to the folder with its name

    'creating a new sheet to insert the chart
    Worksheets.Add(after:=Worksheets(1)).Name = "Image"

    ActiveSheet.Shapes.AddChart.Select
    Set objChart = ActiveChart

    'making chart size match image range size
    ActiveSheet.Shapes.Item(1).Width = ws.Range("H6:AB26").Width

    ActiveSheet.Shapes.Item(1).Height = ws.Range("H6:AB26").Height
    objChart.Paste
    objChart.Export (folderpath & picname) 

    'Deletes the Image sheet
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete 'deleting sheet 'Image'
    Application.DisplayAlerts = True

Next Counter

'Turn back on essential functions
Application.ScreenUpdating = True
Application.DisplayStatusBar = True

'Send myself an email to let me know that its finished (I never get to this part)
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItemFromTemplate("C:\Users\Administrator\CHARTS\DONE.oft")
oMail.Send

MsgBox "Done"

End Sub

Answer 1

将 DoEvents 代码放入您的 for 循环中几次。

https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/doevents-function

这应该允许您的处理器执行一些任务，它会使您的代码花费更长的时间，但应该避免内存已满的情况:)

Answer 2

将 Set oApp = CreateObject("Outlook.Application") 放在 For 循环之外。

Answer 3

我一直找不到内存泄漏的解决方案，所以我转而在 PHP 而不是 excel 中生成图表。

通过 VBA 创建图表 - 内存不足，无法完成此操作

Creating Charts via VBA - There isn't enough memory to complete this action

excel

outlook

vba

out-of-memory