执行VBA宏后PowerPoint内存占用仍居高不下的问题求助

问题背景 #

我在PowerPoint中开发了VBA工具以提升数据图表处理效率，其中一款可将选中幻灯片上的图表数据按从高到低排序。但同时对多张幻灯片运行代码时，VBA内存占用会大幅攀升（2-3倍甚至更高），且宏执行完毕后内存始终无法回落，必须关闭程序才能释放，严重影响电脑正常使用。

原代码 #

Sub Sortchart()
Dim shp As PowerPoint.Shape
Dim sld As Slide
Dim mychart As PowerPoint.Chart
Dim lastRow As Long
Dim LastCol As Long

For Each sld In ActiveWindow.Selection.SlideRange
    For Each shp In sld.Shapes
        If shp.HasChart Then
            Set mychart = shp.Chart
            With mychart
                Set mysheet = .ChartData.Workbook.Sheets(1)
                With mysheet
                    lastRow = mysheet.usedrange.Rows.Count
                    LastCol = mysheet.usedrange.Columns.Count + 1
                    If LastCol > 3 Then
                        MsgBox "This chart is not sortable. Please do it manually."
                    Else
                        .Range(.Cells(1, LastCol - 1), .Cells(lastRow, LastCol)).sort Key1:=.Range("C1"), Order1:=1, Header:=xlyes
                    End If
                End With
            End With
        End If
    Next shp
Next sld
Set shp = Nothing
Set sld = Nothing
Set mychart = Nothing
End Sub

解决方案 #

1. 显式关闭并释放ChartData工作簿 #

原代码最大的问题是打开图表关联的Excel工作簿后未关闭，导致大量内存被占用且无法释放。每次操作完图表数据后，必须主动关闭对应工作簿并释放对象：

' 在mysheet操作结束后添加
mychart.ChartData.Workbook.Close SaveChanges:=True
Set mysheet = Nothing

2. 声明变量时指定具体类型 #

原代码中mysheet未声明类型，默认会成为变体类型，额外增加内存开销。在变量声明部分补充：

Dim mysheet As Excel.Worksheet

同时需确保PowerPoint VBA工程已引用Microsoft Excel对象库（路径：工具→引用→勾选Microsoft Excel xx.x Object Library）。

3. 优化UsedRange的使用逻辑 #

UsedRange可能包含空单元格导致范围不准确，且频繁调用会增加内存负担。改为从底部/右侧反向查找真实的最后一行/列：

' 替换原lastRow和LastCol的获取代码
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
lastRow = .Cells(.Rows.Count, LastCol - 1).End(xlUp).Row

4. 分批处理并定期释放内存 #

处理大量幻灯片时，可每处理N张就触发一次资源释放，缓解内存压力：

' 在幻灯片循环中添加，例如每处理5张执行一次
If (sld.Index Mod 5) = 0 Then
    DoEvents
    Set mychart = Nothing
    Set mysheet = Nothing
    ' 调用Excel垃圾回收（需引用Excel对象库）
    Excel.Application.GarbageCollect
End If

5. 完整优化后的代码 #

Sub Sortchart_Optimized()
    Dim shp As PowerPoint.Shape
    Dim sld As Slide
    Dim mychart As PowerPoint.Chart
    Dim mysheet As Excel.Worksheet ' 显式声明类型
    Dim lastRow As Long
    Dim LastCol As Long
    
    ' 禁用屏幕刷新和事件，提升效率并减少内存消耗
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each sld In ActiveWindow.Selection.SlideRange
        For Each shp In sld.Shapes
            If shp.HasChart Then
                Set mychart = shp.Chart
                ' 跳过链接外部数据源的图表
                If mychart.ChartData.IsLinked Then
                    MsgBox "Linked charts cannot be sorted with this tool.", vbExclamation
                Else
                    mychart.ChartData.Activate
                    Set mysheet = mychart.ChartData.Workbook.Sheets(1)
                    
                    With mysheet
                        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
                        If LastCol > 3 Then
                            MsgBox "This chart is not sortable. Please do it manually.", vbExclamation
                        Else
                            lastRow = .Cells(.Rows.Count, LastCol - 1).End(xlUp).Row
                            .Range(.Cells(1, LastCol - 1), .Cells(lastRow, LastCol)).Sort _
                                Key1:=.Range("C1"), Order1:=xlDescending, Header:=xlYes
                        End If
                    End With
                    
                    ' 关闭工作簿并释放对象
                    mychart.ChartData.Workbook.Close SaveChanges:=True
                    Set mysheet = Nothing
                End If
                Set mychart = Nothing
            End If
        Next shp
        
        ' 每处理5张幻灯片释放一次内存
        If (sld.Index Mod 5) = 0 Then
            DoEvents
            Application.Calculate
        End If
    Next sld
    
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    ' 释放所有对象
    Set shp = Nothing
    Set sld = Nothing
End Sub

内容的提问来源于stack exchange，提问作者user2678840