Excel VBA决策树脚本执行无响应问题求助

我想编写一款无需操作Excel Shapes的VBA脚本，可直接输入决策树条目，每条分支对应时长，路径末尾显示该路径的总时长。但运行以下两段测试代码后，Excel工作表无任何反应：

第一段测试代码 #

Sub CreateDecisionTree()
 
 'Declare variables
 Dim objExcel As Excel.Application Dim objWorkbook As Excel.Workbook
 Dim objWorksheet As Excel.Worksheet Dim objShape As Excel.Shape 
 Dim totalDays As Integer 'Variable to store the total number of days
 
 'Create an Excel application object 
 Set objExcel = New Excel.Application
 
 'Add a new workbook 
 Set objWorkbook = objExcel.Workbooks.Add
 
 'Add a new worksheet 
 Set objWorksheet = objWorkbook.Sheets.Add
 
 'Add the first decision point shape 
 Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 50, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 1 (1 day)"
 totalDays = totalDays + 1
 
 'Add the second decision point shape Set objShape =
 objWorksheet.Shapes.AddShape(msoShapeOval, 200, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 2 (1 day)"
 totalDays = totalDays + 1
 
 'Connect the decision point shapes with a line Set objShape =
 objWorksheet.Shapes.AddLine(75, 75, 225, 75)
 
 'Add the third decision point shape Set objShape =
 objWorksheet.Shapes.AddShape(msoShapeOval, 350, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 3 (1 day)"
 totalDays = totalDays + 1
 
 'Connect the decision point shapes with a line Set objShape =
 objWorksheet.Shapes.AddLine(375, 75, 375, 175)
 
 End Sub

第二段测试代码 #

Sub CreateTOCTree()
 
 'Declare variables 
 Dim objExcel As Excel.Application Dim objWorkbook As Excel.Workbook 
 Dim objWorksheet As Excel.Worksheet Dim objShape As Excel.Shape
 
 'Create an Excel application object 
 Set objExcel = New Excel.Application
 
 'Add a new workbook 
 Set objWorkbook = objExcel.Workbooks.Add
 
 'Add a new worksheet 
 Set objWorksheet = objWorkbook.Sheets.Add
 
 'Add the first decision point shape 
 Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 50, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 1"
 
 'Add the second decision point shape
 Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 200, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 2"
 
 'Connect the decision point shapes with a line
 Set objShape = objWorksheet.Shapes.AddLine(75, 75, 225, 75)
 
 'Add the third decision point shape
 Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 350, 50, 50, 50)
 objShape.TextFrame.Characters.Text = "Decision Point 3"
 
 'Check if Excel application object was created successfully
 If objExcel Is Nothing Then
     MsgBox "Excel application object could not be created."
     Exit Sub End If
 
 End Sub

1. 后台Excel实例未显示：两段代码都通过New Excel.Application创建了隐藏的Excel后台实例，所有操作都在这个不可见的实例中进行，当前Excel窗口自然看不到效果。
2. 语法错误：第一段代码存在语句换行错误（如Set objShape =单独占一行），导致代码无法正常编译执行。
3. 逻辑错误：第二段代码的实例有效性判断放在实例创建之后，完全起不到错误检测作用。
4. 偏离需求：两段代码都依赖Shapes实现，和你“无需操作Excel Shapes”的核心需求不符。

一、修复测试代码（解决无反应问题） #

以下是修正语法错误并显示Excel实例的版本，运行后能看到创建的Shapes：

Sub CreateDecisionTree_Fixed()
    'Declare variables
    Dim objExcel As Excel.Application
    Dim objWorkbook As Excel.Workbook
    Dim objWorksheet As Excel.Worksheet
    Dim objShape As Excel.Shape
    Dim totalDays As Integer 'Variable to store the total number of days
    
    '创建Excel实例并设置为可见
    Set objExcel = New Excel.Application
    objExcel.Visible = True '关键：显示后台实例
    
    '添加新工作簿和工作表
    Set objWorkbook = objExcel.Workbooks.Add
    Set objWorksheet = objWorkbook.Sheets.Add
    
    '添加第一个决策点
    Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 50, 50, 50, 50)
    objShape.TextFrame.Characters.Text = "决策点1（1天）"
    totalDays = totalDays + 1
    
    '添加第二个决策点
    Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 200, 50, 50, 50)
    objShape.TextFrame.Characters.Text = "决策点2（1天）"
    totalDays = totalDays + 1
    
    '连接两个决策点
    Set objShape = objWorksheet.Shapes.AddLine(75, 75, 225, 75)
    
    '添加第三个决策点
    Set objShape = objWorksheet.Shapes.AddShape(msoShapeOval, 350, 50, 50, 50)
    objShape.TextFrame.Characters.Text = "决策点3（1天）"
    totalDays = totalDays + 1
    
    '连接第三个决策点
    Set objShape = objWorksheet.Shapes.AddLine(375, 75, 375, 175)
    
    '在工作表中显示总时长
    objWorksheet.Range("A10").Value = "总时长：" & totalDays & " 天"
End Sub

二、无需Shapes的决策树实现（满足核心需求） #

以下是用纯单元格文本+公式实现的决策树，直接输入分支和时长，自动计算路径总时长：

Sub CreateDecisionTree_WithoutShapes()
    Dim ws As Worksheet
    Dim rowOffset As Integer
    Dim totalTime As Integer
    
    '使用当前活动工作表，无需新建Excel实例
    Set ws = ActiveSheet
    ws.Cells.Clear '清空工作表内容
    
    '初始化决策树根节点
    ws.Range("A1").Value = "决策点1"
    ws.Range("B1").Value = 1 '根节点对应时长
    rowOffset = 2
    
    '分支1：决策点2 -> 路径1终点
    ws.Range("A" & rowOffset).Value = "├─ 分支1：决策点2"
    ws.Range("B" & rowOffset).Value = 2 '分支1时长
    rowOffset = rowOffset + 1
    ws.Range("A" & rowOffset).Value = "│  └─ 路径1终点"
    totalTime = ws.Range("B1").Value + ws.Range("B" & rowOffset - 1).Value
    ws.Range("C" & rowOffset).Value = "总时长：" & totalTime & " 天"
    rowOffset = rowOffset + 1
    
    '分支2：决策点3 -> 路径2终点
    ws.Range("A" & rowOffset).Value = "└─ 分支2：决策点3"
    ws.Range("B" & rowOffset).Value = 3 '分支2时长
    rowOffset = rowOffset + 1
    ws.Range("A" & rowOffset).Value = "   └─ 路径2终点"
    totalTime = ws.Range("B1").Value + ws.Range("B" & rowOffset - 1).Value
    ws.Range("C" & rowOffset).Value = "总时长：" & totalTime & " 天"
    
    '格式化单元格
    ws.Columns("A:C").AutoFit
    ws.Range("C:C").Font.Bold = True '总时长加粗显示
End Sub

使用说明 #

1. 运行CreateDecisionTree_WithoutShapes后，当前工作表会生成纯文本结构的决策树。
2. 修改代码中B列的数值可调整对应分支的时长，路径终点的总时长会自动累加计算。
3. 如需扩展更多分支，只需按照现有格式添加行，并累加对应节点的时长即可。

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