用VBA如何插入图示？

dongdonggege

lss001 发表于 2024-10-1 22:36
如果是不能创建Shape对象
可以考虑使用AddDiagram创建Shape对象
Set shp = ThisDocument.Shapes.AddDia ...

前面的程序，等待审核。

dongdonggege

lss001 发表于 2024-10-1 22:36
如果是不能创建Shape对象
可以考虑使用AddDiagram创建Shape对象
Set shp = ThisDocument.Shapes.AddDia ...

这是效果图

dongdonggege

lss001 发表于 2024-10-1 22:36
如果是不能创建Shape对象
可以考虑使用AddDiagram创建Shape对象
Set shp = ThisDocument.Shapes.AddDia ...

参数值，

dongdonggege

lss001 发表于 2024-10-1 22:36
如果是不能创建Shape对象
可以考虑使用AddDiagram创建Shape对象
Set shp = ThisDocument.Shapes.AddDia ...

我搜索添加节点msoDiagramAssistant，msoDiagramNode关系图节点遇到问题，下面是程序，

Sub AddNodeToDiagram()
    Dim shpDiagram As Shape
    Dim sht As Worksheet
   
    ' 设定工作表
    Set sht = ActiveSheet   
    ' 添加关系图
    Set shpDiagram = sht.Shapes.AddDiagram(msoDiagramOrgChart, _
        Left:=100, Top:=100, Width:=300, Height:=300)   
    ' 添加节点
    Dim shpNode As Shape
    Set shpNode = shpDiagram.DiagramNodes.Add(100, 100, msoDiagramNode)   
    ' 设置节点文本
    shpNode.TextFrame.Characters.Text = "新节点"   
End Sub
Set shpNode这句，对象不支持该属性和方法。shpDiagram图形里不能添加图形。不知如何解决？求老师指教。半夜三点睡不着就来了，每次都审核不通过。

lss001

dongdonggege 发表于 2024-10-2 05:56
我搜索添加节点msoDiagramAssistant，msoDiagramNode关系图节点遇到问题，下面是程序，

Sub AddNodeTo ...

word2003英文版参考文档摘下来的

Sub TransferChildNodes()
    Dim dgnNode As DiagramNode
    Dim shpDiagram As Shape
    Dim intCount As Integer

    'Add organizational chart to current document
    Set shpDiagram = ThisDocument.Shapes.AddDiagram _
        (Type:=msoDiagramOrgChart, Left:=10, _
        Top:=15, Width:=400, Height:=475)

    'Add first node to organizational chart
    Set dgnNode = shpDiagram.DiagramNode.Children.AddNode

    'Add three child nodes to first node
    For intCount = 1 To 3
        dgnNode.Children.AddNode
    Next intCount

    'Add three child nodes to the first child node
    'of the first node
    For intCount = 1 To 3
        dgnNode.Children.Item(1).Children.AddNode
    Next intCount

    'Move the child nodes of the first child node
    'so they become child nodes of the third child node
    dgnNode.Children.Item(1).TransferChildren _
        ReceivingNode:=dgnNode.Children.Item(3)

End Sub

dongdonggege

lss001 发表于 2024-10-2 06:35
word2003英文版参考文档摘下来的

Sub TransferChildNodes()

很牛，感谢老师辛苦的付出，ThisDocument要改为ActiveDocument，死了两次。最后一句，不能通过，是不是移动节点的？效果图

dongdonggege

lss001 发表于 2024-10-2 06:35
word2003英文版参考文档摘下来的

Sub TransferChildNodes()

最后，又增加两句，
Set shpText = shpDiagram.DiagramNode.Children(1).TextShape
    shpText.TextFrame.TextRange.Text = "2024年国庆节"

lss001

dongdonggege 发表于 2024-10-2 09:59
很牛，感谢老师辛苦的付出，ThisDocument要改为ActiveDocument，死了两次。最后一句，不能通过，是不是移 ...

最后是移动子节点
不通过可以检查一下属性以及参数

dongdonggege

lss001 发表于 2024-10-2 10:41
最后是移动子节点
不通过可以检查一下属性以及参数

'创建组织结构图,并向中间的图表节点添加子节点
Sub AddChildrenToMiddle()
    Dim dgnRoot As DiagramNode, dgnNext As DiagramNode
    Dim shpDiagram As Shape
    Dim intCount As Integer
   
    Set shpDiagram = ActiveDocument.Shapes.AddDiagram _
        (Type:=msoDiagramOrgChart, Left:=10, _
        Top:=15, Width:=400, Height:=475)
        
    Set dgnRoot = shpDiagram.DiagramNode.Children.AddNode
   
    For intCount = 1 To 3
        dgnRoot.Children.AddNode
    Next intCount
   
    Set dgnNext = dgnRoot.Children(1).NextNode
   
    For intCount = 1 To 4
        dgnNext.Children.AddNode
    Next intCount

    Set shpText = shpDiagram.DiagramNode.Children(1).TextShape
    shpText.TextFrame.TextRange.Text = "2024年国庆节"
End Sub

dongdonggege

lss001 发表于 2024-10-2 10:41
最后是移动子节点
不通过可以检查一下属性以及参数

'创建组织结构图,并向中间的图表节点添加子节点
Sub AddChildrenToMiddle2()
    Dim dgnRoot As DiagramNode, dgnNext As DiagramNode
    Dim shpDiagram As Shape
    Dim intCount As Integer
   
    Set shpDiagram = ActiveDocument.Shapes.AddDiagram _
        (Type:=msoDiagramOrgChart, Left:=10, _
        Top:=15, Width:=400, Height:=475)
        
    Set dgnRoot = shpDiagram.DiagramNode.Children.AddNode
    Set shpText = shpDiagram.DiagramNode.Children(1).TextShape
        shpText.TextFrame.TextRange.Text = "2024年国庆节"
        
    For intCount = 1 To 3
        dgnRoot.Children.AddNode
        Set shpText = dgnRoot.Children(intCount).TextShape
        shpText.TextFrame.TextRange.Text = "2024年国庆节" & intCount
    Next intCount
   
    Set dgnNext = dgnRoot.Children(1).NextNode
   
    For intCount = 1 To 4
        dgnNext.Children.AddNode
        Set shpText = dgnNext.Children(intCount).TextShape
        shpText.TextFrame.TextRange.Text = "2024年国庆节" & intCount
    Next intCount
End Sub