Organigramm

Hallo,
wer kennt sich etwas aus mit der Erstellung von Organigrammen?
Mit den aufgeführten Befehlen lässt sich zwar ein Organigramm erstellen (die Unterverzeigung habe ich weggelassen), aber ich kann das Textfeld nicht beschriften. Fehlermeldung: Die Text-Eigenschaft des Character-Objektes kann nicht festgelegt werden. Im Archiv habe ich keinen Hinweis gefunden, der mir weiterhilft. Kann mir jemand den richtigen Befehl sagen?
Grüße
Peter
Dim Tabelle As Worksheet
Dim shp As Shape
Dim Zweig As DiagramNode
Set Tabelle = Worksheets("Tabelle1")
Set shp = Tabelle.Shapes.AddDiagram _
(Type:=msoDiagramOrgChart, Left:=400, Top:=50, Width:=400, Height:=400)
Set Zweig = shp.DiagramNode.Children.AddNode
Zweig.Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
Zweig.Shape.Width = 400
Zweig.Shape.TextFrame.Characters.Text = Bname(1)
Die Text-Eigenschaft des Character-Objektes kann nicht festgelegt werden.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Herbert,
ist es wirklich ein Bug im Excel-XP oder mache ich doch etwas falsch? Merkwürdig ist doch, dass man das Problem damit umgehen kann, indem man das Organigramm in Word erstellt und dann nach Excel exportiert, s. unten. Wenn es in Word funktioniert, sollte es doch auch irgendwie mit VBA über Excel zu lösen sein.
Grüße
Peter

Sub TextShapeAddTextüberWord()
' Integer
Dim i As Integer, j As Integer
' string
Dim Str(13) As String
'Objekte
Dim Shape As Object 'Zeichnungsobjekt
Dim Knoten As Object
Dim Wordanwendung As Object
' Eine Wordanwendung als Objekt aufrufen.
Set Wordanwendung = CreateObject("Word.Application")
' Ein neues Worddokument im Hintergrund öffnen.
Wordanwendung.documents.Add
' Eine neue ExcelTabelle öffnen.
Workbooks.Add
' Ein shape-Objekt hinzufügen.
Set Shape = Wordanwendung.ActiveDocument.Shapes.AddDiagram _
(msoDiagramOrgChart, 60, 60, 300, 200)
' Einen Organigramm-Knoten einfügen.
Set Knoten = Shape.DiagramNode.Children.AddNode
Knoten.Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
Knoten.Shape.Width = 300
' Unterknoten einfügen.
For i = 1 To 3
Knoten.Children.AddNode
Knoten.Children.Item(i).Shape.Fill.ForeColor.RGB = RGB(255, 255, 0)
Knoten.Children.Item(i).Shape.Width = 300
Next
'Vorgabe der Knotenbeschriftung
Bname(1) = "Mayer"
Bname (2) = "Müller"
Bname (3) = "Schulze"
Bname (4) = "Schmidt"
' Den Text der Knoten festlegen.
For i = 1 To 4
With Knoten.Diagram.Nodes.Item(i).TextShape.TextFrame.TextRange
.Text = Bname (i)
.Font.Size = 20
.Font.Name = "Arial"
End With
Next
' Organigramm nach Excel kopieren.
Wordanwendung.ActiveDocument.Shapes.SelectAll
Wordanwendung.Selection.Copy
Range("a1").Select
ActiveSheet.Paste
' Quit Word - Wordanwendung schließen
Wordanwendung.Quit saveChanges:=False
ActiveSheet.Shapes.SelectAll
With Selection
.HorizontalAlignment = xlCenter
End With
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Organigramm

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread