使用VBA批量为同格式多Excel文件生成相同图表的问题

我有多个结构格式完全一致的Excel大数据文件，每个文件仅含1个工作表。已实现遍历文件夹执行分隔宏，单个文件生成图表的宏也可正常运行，但将两个宏结合时，调用ChartMake会触发255错误，缩小数据范围后又无图表生成。

原代码 #

单个文件可用的图表宏 #

'Simple Graph Macro that works if run on an individual excel file 

Sub ChartMake()

Dim embeddedchart As Shape

Set embeddedchart = Sheets(1).Shapes.AddChart
embeddedchart.Chart.SetSourceData Source:=Sheets(1).Range("$A:$B,$E:$E,$H:$H")
embeddedchart.Chart.ChartType = xlLine
embeddedchart.Chart.FullSeriesCollection(3).Trendlines.Add Type:=xlLinear, Forward _ :=0, Backward:=0, DisplayEquation:=0, DisplayRSquared:=0, Name:= _ "Linear ( Channel 3  Measured value  pH)"
End Sub

遍历文件夹的批量处理宏 #

Sub RunOnAllFilesInFolder()

Dim folderName As String, eApp As Excel.Application, fileName As String Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker) Set currWb = ActiveWorkbook
'Select folder in which all files are stored
fDialog.Title = "Select a folder"
fDialog.InitialFileName = currWb.Path
If fDialog.Show = -1 Then
  folderName = fDialog.SelectedItems(1)
End If    

'Create a separate Excel process that is invisibile
Set eApp = New Excel.Application:  eApp.Visible = False

'Search for all files in folder 
fileName = Dir(folderName & "\*.*")
Do While fileName <> ""
    'Update status bar to indicate progress
    Application.StatusBar = "Processing " & folderName & "\" & fileName 
  
    Set wb = Workbooks.Open(folderName & "\" & fileName)
    Set wb = Workbooks(fileName)
    wb.Activate
    wb.Worksheets(1).Activate
    ActiveSheet.Select               
               
    'Module1.split_text Delimiting macro, works
    'MsgBox ActiveSheet.Name Just to make sure the current opened worksheet is the active sheet
     Module3.ChartMake ' I either get a 255 error, but if I reduce the range, nothing comes up
  
    wb.Close SaveChanges:=True 
    Debug.Print "Processed " & amp; folderName & amp; "\" & amp; fileName
    fileName = Dir()
Loop
eApp.Quit
Set eApp = Nothing  
End Sub

问题原因 #

1. 跨进程对象引用错误：批量宏创建了独立的后台Excel进程eApp，但ChartMake直接用Sheets(1)会默认指向当前前台Excel进程，导致对象引用失败（255错误）。
2. 工作簿对象赋值混乱：Set wb = Workbooks.Open(...)后重复执行Set wb = Workbooks(fileName)，可能导致对象指向错误。
3. 数据范围不合理：直接使用整列$A:$B,$E:$E,$H:$H包含大量空行，大数据集下易触发错误且效率极低。

修正后的代码 #

改进版图表生成宏（支持参数传入） #

' 接收目标工作簿参数的图表生成宏
Sub ChartMake(targetWb As Workbook)
    Dim embeddedChart As Shape
    Dim targetWs As Worksheet
    Dim dataRange As Range
    Dim lastRowA As Long, lastRowE As Long, lastRowH As Long
    
    Set targetWs = targetWb.Worksheets(1)
    ' 获取各列实际有数据的最后一行，避免空行干扰
    lastRowA = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
    lastRowE = targetWs.Cells(targetWs.Rows.Count, "E").End(xlUp).Row
    lastRowH = targetWs.Cells(targetWs.Rows.Count, "H").End(xlUp).Row
    
    ' 合并有效数据范围
    Set dataRange = Union( _
        targetWs.Range("A1:B" & lastRowA), _
        targetWs.Range("E1:E" & lastRowE), _
        targetWs.Range("H1:H" & lastRowH) _
    )
    
    Set embeddedChart = targetWs.Shapes.AddChart
    embeddedChart.Chart.SetSourceData Source:=dataRange
    embeddedChart.Chart.ChartType = xlLine
    
    ' 确保第3个系列存在时再添加趋势线，避免报错
    If embeddedChart.Chart.SeriesCollection.Count >= 3 Then
        embeddedChart.Chart.SeriesCollection(3).Trendlines.Add _
            Type:=xlLinear, Forward:=0, Backward:=0, _
            DisplayEquation:=0, DisplayRSquared:=0, _
            Name:="Linear ( Channel 3  Measured value  pH)"
    End If
End Sub

改进版批量处理宏 #

Sub RunOnAllFilesInFolder()
    Dim folderName As String, eApp As Excel.Application, fileName As String
    Dim wb As Workbook, currWb As Workbook
    Dim fDialog As Object
    
    Set currWb = ActiveWorkbook
    ' 选择目标文件夹
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    fDialog.Title = "选择存放Excel文件的文件夹"
    fDialog.InitialFileName = currWb.Path
    
    If fDialog.Show <> -1 Then Exit Sub ' 用户取消选择则退出
    
    folderName = fDialog.SelectedItems(1)
    ' 创建后台Excel进程
    Set eApp = New Excel.Application
    eApp.Visible = False
    
    ' 只遍历Excel格式文件（.xls/.xlsx）
    fileName = Dir(folderName & "\*.xls*")
    Do While fileName <> ""
        Application.StatusBar = "正在处理：" & folderName & "\" & fileName
        
        ' 直接在后台进程打开文件，避免对象混乱
        Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
        
        ' 执行分隔宏（如有需要）
        ' eApp.Run "Module1.split_text"
        
        ' 调用改进后的图表宏，传入当前后台工作簿
        ChartMake wb
        
        wb.Close SaveChanges:=True
        Debug.Print "已处理：" & folderName & "\" & fileName
        fileName = Dir()
    Loop
    
    ' 清理资源
    eApp.Quit
    Set eApp = Nothing
    Set wb = Nothing
    Application.StatusBar = "" ' 重置状态栏
End Sub

关键修改说明 #

• 参数化图表宏：通过传入targetWb参数，明确指向后台进程的工作簿，解决跨进程对象引用错误。
• 动态数据范围：用End(xlUp)获取各列实际数据行，避免整列空行导致的大数据量问题。
• 修复工作簿赋值：直接通过后台进程eApp.Workbooks.Open打开文件，避免重复赋值引发的对象混乱。
• 增加错误防护：添加系列数量判断，防止因数据缺失导致趋势线添加失败。

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