VBA从选定数据创建新工作表图表时遇报错及解决问询

错误根源拆解 #

1. 运行时错误13（类型不匹配）
   当选中的不是单元格区域（比如图表、形状等非单元格对象）时，Set rng = Selection会触发类型不匹配，因为Selection的类型无法赋值给Range变量。

2. Sheet2不存在导致的超出范围错误
   代码直接调用Sheets("Sheet2")，但如果工作簿中没有这个工作表，就会触发“下标越界”错误。

3. SetElement方法失败
   原代码逻辑混乱：先在当前工作表创建图表并选中，随后激活Sheet2，此时ActiveChart已经不是之前创建的图表对象（激活新工作表后，原图表不再处于活动状态）；另外，.Location Where:=xlLocationAsNewSheet, Name:="Sheet2"会新建一个名为Sheet2的工作表存放图表，如果之前已手动创建Sheet2，会触发名称重复错误，同时导致之前复制到Sheet2的数据所在工作表的对象引用失效。

修正后的VBA代码 #

Sub CreateChartFromSelection()
    Dim rng As Range
    Dim targetSheet As Worksheet
    Dim newChart As Chart
    
    ' 验证选中的是单元格区域，避免类型不匹配错误
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中单元格区域！", vbExclamation
        Exit Sub
    End If
    Set rng = Selection
    
    ' 检查并创建Sheet2（不存在则新建）
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    On Error GoTo 0
    If targetSheet Is Nothing Then
        Set targetSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetSheet.Name = "Sheet2"
    End If
    
    ' 复制选中的数据到Sheet2的C4位置
    rng.Copy Destination:=targetSheet.Range("C4")
    
    ' 在Sheet2中创建簇状条形图并绑定数据源
    Set newChart = targetSheet.Shapes.AddChart2(Style:=201, XlChartType:=xlBarClustered).Chart
    newChart.SetSourceData Source:=targetSheet.Range("C4").Resize(rng.Rows.Count, rng.Columns.Count)
    
    ' 设置图表标题
    newChart.SetElement msoElementChartTitleAboveChart
    newChart.ChartTitle.Text = ThisWorkbook.Sheets("Sheet1").Range("B1").Value
    
    ' 可选：若需将图表单独放在新工作表，注意不要与现有Sheet2重名
    ' newChart.Location Where:=xlLocationAsNewSheet, Name:="ChartSheet"
End Sub

关键修正点说明 #

• 选中类型验证：通过TypeName(Selection)判断是否为Range，从源头避免类型不匹配错误。
• 安全创建工作表：先尝试获取Sheet2，不存在则新建，彻底解决下标越界问题。
• 直接绑定Chart对象：使用Set newChart = ...直接获取图表对象，不再依赖ActiveChart，避免因工作表切换导致的对象引用失效。
• 明确关联数据源：创建图表后直接绑定Sheet2中复制的数据区域，确保图表能正确读取数据。
• 调整操作顺序：先创建图表并绑定数据源，再设置标题等元素，避免对象状态变化导致的方法调用失败。

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