Organigramm aufklappbar machen?

Hallo zusammen,

ich müsste ein Organigramm ähnlich wie im Beispiel aus dem Bild (Excel) aufklappbar machen.

Heißt ich habe Überpunkte, klicke auf ein Zeichen und dann geht der jeweilige Bereich dazu auf.

 Kennt ihr eine Möglichkeit dazu in Powerpoint oder ähnlichem. Oder gibt es ein Programm mit dem das darstellbar ist?

Danke schonmal!

Answer 1

[IchMalWiederXY]

In Excel gibt es unter "Einfügen->Smart Art " auch Organigram Optionen.
Diese sind aber nicht wirklich klappbar.
Hier bietet Google Graph eine Lösung, die aus Excel heraus unterstützt werden kann.
Ich habe eine Excel Seite: Klickt man auf "Orga HTML" wird eine Google Graph Seite erstellt.

Wenn du eine Excel Datei entsprechend vorbereitest und dann diesen Code ausführst:

Public Sub sbCreateOrgaMulTopsHTML()
Dim strPageConfig, orgWizArgs
Dim visExcelFile
Dim myPath As String
Dim myTopsStr As String
Dim fs As New Scripting.FileSystemObject

Dim i As Integer
Dim a As Integer
Dim s As Integer
Dim j As Integer
Dim myText As String
Dim allHirar As String

Dim myFr1 As String
Dim myFr2 As String

myFr1 = "[{v:'_PERSON_', f:'_PERSON_<div style=" & Strings.Chr(34) & "color:red; font-style:italic" & Strings.Chr(34) & " >_ROLE_</div>'},'_MANAGER_', '_TOOLTIP_'],"
myFr2 = "[{v:'_PERSON_', f:'_PERSON_<div style=" & Strings.Chr(34) & "color:red; font-style:italic" & Strings.Chr(34) & " >_ROLE_</div>'},'_MANAGER_', '_TOOLTIP_']"

myPath = ActiveWorkbook.Path & "\" & Worksheets("Hirarchy").Range("B2").Value & ".html"
a = FileSystem.FreeFile
i = 5

allHirar = ""
Do While WorksheetFunction.CountA(Worksheets("Hirarchy").Range("A" & i & ":C50000")) > 0
    If WorksheetFunction.CountA(Worksheets("Hirarchy").Range("A" & (i + 1) & ":C50000")) = 0 Then
        myText = myFr2
    Else
        myText = myFr1
    End If
    myText = Strings.Replace(myText, "_PERSON_", Worksheets("Hirarchy").Range("A" & i).Value, 1, -1, vbTextCompare)
    myText = Strings.Replace(myText, "_MANAGER_", Worksheets("Hirarchy").Range("B" & i).Value, 1, -1, vbTextCompare)
    myText = Strings.Replace(myText, "_ROLE_", Worksheets("Hirarchy").Range("C" & i).Value, 1, -1, vbTextCompare)
    myText = Strings.Replace(myText, "_TOOLTIP_", Worksheets("Hirarchy").Range("D" & i).Value, 1, -1, vbTextCompare)
    allHirar = allHirar & myText & vbCrLf
    i = i + 1
Loop
Worksheets("HTMLFrame").Range("B2").Value = allHirar
Open myPath For Output As #a
Print #a, Worksheets("HTMLFrame").Range("B1").Value & allHirar & Worksheets("HTMLFrame").Range("B3").Value
Close #a
MsgBox "Orga created in: " & vbCrLf & ActiveWorkbook.Path, vbInformation, "Tool Help"

End Sub

Erhälst du eine HTML Seite die So aussieht (auch klappbar)

Man kann auch "Microsoft Visio" entsprechend fernsteuern dann bekommt man so etwas:

Comments

[Wastz]

Vielen Dank für die super ausführliche Antwort und den Code dazu!

[IchMalWiederXY]

@Wastz

Viel Spaß beim Nachbauen. Da Organigramm Software recht kostspielig ist habe ich -damals- ein wenig gebastelt.

Answer 2

[DanKirpan]

In Excel kannst du dafür z.B die gerade nicht benötigten Zeilen über ein ActiveX-Steuerelement-Kontrollkästchen ein- bzw ausblenden:

• Entwicklertools->Einfügen->Kontrollkästchen
• im Entwurfsmodus rechtsklicken -> Code anzeigen
• das folgende einfügen und die Zeilenzahl anpassen:

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
    Rows("3:7").Select
    Selection.EntireRow.Hidden = False
    Else
      Rows("3:7").Select
    Selection.EntireRow.Hidden = True
End If
End Sub

Die Registerkarte "Entwicklertools ist standardmäßig ausgeblendet, du müsstest sie daher evtl erst über Datei->Optionen-> Menüband anpassen aktivieren