Excel 数据生成树状组织架构图 - VBA 代码

以下是使用 VBA 生成树状组织架构图的代码，根据你提供的 Excel 数据，老板为第一级在最上面，部门长为第二级在下面，普通员工为第三级在最下面：

Sub GenerateOrganizationChart()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim oshp As Object
    Dim orgChart As Object
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Integer
    Dim rootNode As Object
    Dim managerNode As Object
    Dim employeeNode As Object
    
    ' 创建 PowerPoint 应用程序对象
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True ' 可见性设置为 True
    
    ' 创建一个新的演示文稿
    Set pptPres = pptApp.Presentations.Add
    
    ' 创建一个新的幻灯片
    Set pptSlide = pptPres.Slides.Add(1, 2) ' 在这里使用幻灯片类型为 2，表示组织架构图
    
    ' 在幻灯片上创建组织架构图
    Set oshp = pptSlide.Shapes.AddSmartArt(3, Left:=100, Top:=100, Width:=500, Height:=300)
    Set orgChart = oshp.SmartArt
    
    ' 设置组织架构图的样式为树型
    orgChart.Layout = 2 ' 2 表示树型样式
    
    ' 打开 Excel 文件
    Set wb = Workbooks.Open("路径\文件名.xlsx") ' 将 '路径\文件名.xlsx' 修改为你的 Excel 文件路径和名称
    Set ws = wb.Sheets("Sheet1") ' 将 'Sheet1' 修改为包含组织架构数据的工作表名称
    Set rng = ws.Range("A2:B6") ' 将 'A2:B6' 修改为包含组织架构数据的范围
    
    ' 读取 Excel 数据并创建组织架构图节点
    For i = 1 To rng.Rows.Count
        If rng.Cells(i, 2).Value = "老板" Then
            ' 添加老板节点
            Set rootNode = orgChart.Nodes.Add
            rootNode.TextFrame2.TextRange.Text = rng.Cells(i, 1).Value
        ElseIf rng.Cells(i, 2).Value = "部门长" Then
            ' 添加部门长节点
            Set managerNode = rootNode.Nodes.Add
            managerNode.TextFrame2.TextRange.Text = rng.Cells(i, 1).Value
        ElseIf rng.Cells(i, 2).Value = "员工" Then
            ' 添加普通员工节点
            Set employeeNode = managerNode.Nodes.Add
            employeeNode.TextFrame2.TextRange.Text = rng.Cells(i, 1).Value
        End If
    Next i
    
    ' 保存演示文稿
    pptPres.SaveAs "路径\文件名.pptx" ' 将 '路径\文件名.pptx' 修改为你想要保存的 PowerPoint 文件的路径和名称
    
    ' 关闭 PowerPoint 应用程序对象
    pptApp.Quit
    
    ' 关闭并保存 Excel 文件
    wb.Close SaveChanges:=True
    
    ' 释放对象变量
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

请注意将代码中的'路径\文件名.xlsx'修改为包含组织架构数据的 Excel 文件的路径和名称，并将'Sheet1'修改为包含数据的工作表名称。此外，你可以根据需要调整代码中的范围和单元格位置。