VBAで組織図を作る

まずはサンプルをあさってみる、とMSDNにそのものズバリなのがあった。

社員リストを使って組織図を作成する

概要 : Microsoft Office 10.0 オブジェクト ライブラリには、 Word、PowerPoint および Excel で図表を作成するための新しいオブジェクトが含まれています。この記事では、これらの新しいオブジェクトについて説明し、データベース内のデータから組織図を作成する方法を示しています。

おっし。これでやってみるべ。

とりあえず新規Excelブックでマクロを登録してサンプルを動かしてみる。

Sub createOrgChart()
    Dim shpValiable As Shape
   Set shpVariable = CreateDiagram(objDocument:=ActiveWorkbook _
   .Sheets(1), DiagramType:=msoDiagramRadial, intLeft:=0, _
   intTop:=0, intWidth:=100, intHeight:=100)

    Call AddDiagramNodes(shpVariable, 10)
End Sub

Function CreateDiagram(ByRef objDocument As Object, _
      ByVal DiagramType As MsoDiagramType, ByVal intLeft As Integer, _
      ByVal intTop As Integer, ByVal intWidth As Integer, _
      ByVal intHeight As Integer) As Shape

   Set CreateDiagram = objDocument.Shapes.AddDiagram _
      (Type:=DiagramType, Left:=intLeft, Top:=intTop, _
      Width:=intWidth, Height:=intHeight)

End Function

Function AddDiagramNodes(ByVal shpDiagram As Shape, _
      ByVal intNumNodes As Integer) As Boolean

   Dim dgnChild As DiagramNode
   Dim intNodes As Integer

   On Error GoTo Error_Handler

   '図表の種類を判断し、必要に応じて最初のノードを追加します。
   Select Case shpDiagram.Diagram.Type

      Case msoDiagramOrgChart, msoDiagramRadial
         '最初のノードを追加します。
         Set dgnChild = shpDiagram.DiagramNode.Children.AddNode
         Call AddTextToNode(objDiagramNode:=dgnChild, _
        strNodeText:="Parent.", _
        intFontSize:=8, blnBold:=True)

         '残りのノードを最初のノードの子ノードとして追加します。
         For intNodes = 1 To intNumNodes - 1
                     Call AddTextToNode(objDiagramNode:=dgnChild.Children.AddNode, _
        strNodeText:="Child.", _
        intFontSize:=8, blnBold:=False)

            
         Next intNodes

      Case Else
         '最初のノードを追加します。
         Set dgnChild = shpDiagram.DiagramNode.Children.AddNode
         Call AddTextToNode(objDiagramNode:=dgnChild, _
        strNodeText:="This is text for a node.", _
        intFontSize:=8, blnBold:=True)
         '残りのノードを追加します。
         For intNodes = 1 To intNumNodes - 1
            dgnChild.AddNode
         Next intNodes

   End Select

   AddDiagramNodes = True

Exit_Sub:
   Exit Function

Error_Handler:
   AddDiagramNodes = False
   Resume Exit_Sub

End Function

Sub AddTextToNode(ByRef objDiagramNode As DiagramNode, _
      ByVal strNodeText As String, _
      Optional ByVal intFontSize As Integer = 10, _
      Optional ByVal strFontName As String = "Tahoma", _
      Optional ByVal blnBold As Boolean = False, _
      Optional ByVal blnItalic As Boolean = False)

   With objDiagramNode.TextShape.TextFrame
      With .TextRange

         'ノードにテキストを追加します。
         .Characters.Text = strNodeText

         '新しいテキストを指定した書式に設定します。
         With .Font
            .Bold = blnBold
            .Italic = blnItalic
            .Name = strFontName
            .Size = intFontSize
         End With
      End With
   End With

End Sub

ノードはできるんだが、テキストが反映されねぇ('A`)

よく読んでみると

Excelで書く場合は

注意 Excel では、TextRange オブジェクトの Characters プロパティを使って、その Text プロパティおよびノードの Text プロパティにアクセスします。その後、Characters オブジェクトの Text プロパティを使って、図表ノードにテキストを挿入します。

ってなってたんだが、そもそもTextRangeオブジェクトってのが無い。
その代わりにTextFrame.Characters.Textがあったからこっちを使ってみる。

結果

「Character クラスの Text プロパティに設定できませんでした。」
('A`)ヴァー

とりあえず試してみたこと

• ActiveSheet.Unprotect
• (node).Shape.Locked = False
  (node).Shape.ControlFormat.LockedText = False
• ActiveSheet.Protect Scenarios:=True, UserInterfaceOnly:=False

うんこっこー('A`)

なんつーか

非常に面倒な案件掴んだ？
さてさて、どーすっか。