none
PPT 2013 Inhaltsverzeichnis nach Abschnitten RRS feed

  • Frage

  • Hallo,

    ich versuche automatisch ein Inhaltsverzeichnis anhand der vorhandenen Folien zu erstellen. Dieses soll nach den Abschnitten gegliedert werden. Die Schleife über die Folien habe ich bereits. Wie kann ich die Abschnitte finden? Das Objektmodel von PowerPoint war (zumindest für mich) da nicht sehr hilfreich. Kann mir jemand helfen?

    Sub Inhaltsverzeichnis()
        Dim x As Slide
        Dim Text As String
        
        'Schleife über alle Folien um die Titel auszulesen
        For Each x In ActivePresentation.Slides
        Text = Text & x.Shapes.Title.TextFrame.TextRange.Text & Chr(10)
        Next
        
        'Einfügen der Agenda in die Folie
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text = "Agenda" Then
                x.Shapes.Placeholders(2).TextFrame.TextRange.Text = Text
                Exit Sub
            End If
        Next
    End Sub
    
    

    Gruß
    Michael

    Donnerstag, 1. Mai 2014 17:17

Antworten

  • Hallo,

    ich habe die Antwort selbst gefunden. Dazu habe ich den nachfolgenden Code aufgebaut. Er ist noch nicht optimal, aber funktioniert. Die Prozedur Inhaltsverzeichnis durchläuft alle Folien in einer Schleife und sammelt die Titel. Gleichzeitig wird über die SectionID der Abschnitt ermittelt. Die Funktion AbschnittErmitteln ließt den Namen und die Anzahl der Folien des aktuellen Abschnitts und fügt dieses Ergebnis am Anfang der Agenda ein. Es werden nur Titel in die Agenda eingefügt, die am Ende keine 2 Leerzeichen haben. Das habe ich gemacht, damit die Agenda nicht zu lang wird, ich kann es anhand des Titels steuern, ohne das es in der Präsentation auffällt.

    Dieser Code kann sicher weiter optimiert werden.

    Gruß
    Michael

    Sub Inhaltsverzeichnis()
        Dim x As Slide
        Dim Abschnitt As String
        Dim Text(100) As String
            
        'Schleife über alle Folien um die Titel auszuleden
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text <> "Agenda" Then
                If Right(x.Shapes.Title.TextFrame.TextRange.Text, 2) <> "  " Then
                    If Text(x.sectionIndex) <> "" Then
                        Text(x.sectionIndex) = Text(x.sectionIndex) & Chr(10) & x.Shapes.Title.TextFrame.TextRange.Text
                        Else
                        Text(x.sectionIndex) = AgendaAbschnitte(x.sectionIndex) & Chr(10)
                        'MsgBox Text(x.sectionIndex)
                        Text(x.sectionIndex) = Text(x.sectionIndex) & x.Shapes.Title.TextFrame.TextRange.Text
                    End If
                End If
            End If
        Next
        
        'Einfügen der Agenda in die Folie
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text = "Agenda" Then
                x.Shapes.Placeholders(2).TextFrame.TextRange.Text = Text(x.sectionIndex)
            End If
        Next
    End Sub
    
    Function AgendaAbschnitte(Abschnitt As Integer) As String
        Dim a As Integer
        With ActivePresentation.SectionProperties
            For a = 1 To .Count
                If a = Abschnitt Then
                AgendaAbschnitte = "" & .Name(a) & " beinhaltet " & _
                 .SlidesCount(a) & " Folien"
                 End If
            Next a
        End With
    End Function

    Samstag, 3. Mai 2014 09:47

Alle Antworten

  • Wie kann ich die Abschnitte finden?

    Hmm... gar nicht? Soweit ich weiß gibt es sowas in PP nicht.

    Daher lautet meine Gegenfrage: Woran siehst Du das Dein PP Abschnitte hat? Kannst Du die Datei mal hochladen?

    Andreas.

    Samstag, 3. Mai 2014 05:54
  • Hallo,

    wir haben uns schon seit längerem mit dem Problem beschäftigt und auch bereits eine Fertige Lösung erstellt um in PPT (2007,2010, 2013) ein Inhaltsverzeichnis mit wenigen klicks zu erstellen mit entsprechenden Backlinks (Hyperlinks) zum Inhaltsverzeichnis zurück und vom Inhaltsverzeichnis auf die jeweilige Folie.

    Unser Lösung, der PowerPoint Contentgenerator

    http://www.stallwanger.net/sites/PPT-Contentgenerator.php

    Samstag, 3. Mai 2014 07:58
  • Hallo,

    ich habe die Antwort selbst gefunden. Dazu habe ich den nachfolgenden Code aufgebaut. Er ist noch nicht optimal, aber funktioniert. Die Prozedur Inhaltsverzeichnis durchläuft alle Folien in einer Schleife und sammelt die Titel. Gleichzeitig wird über die SectionID der Abschnitt ermittelt. Die Funktion AbschnittErmitteln ließt den Namen und die Anzahl der Folien des aktuellen Abschnitts und fügt dieses Ergebnis am Anfang der Agenda ein. Es werden nur Titel in die Agenda eingefügt, die am Ende keine 2 Leerzeichen haben. Das habe ich gemacht, damit die Agenda nicht zu lang wird, ich kann es anhand des Titels steuern, ohne das es in der Präsentation auffällt.

    Dieser Code kann sicher weiter optimiert werden.

    Gruß
    Michael

    Sub Inhaltsverzeichnis()
        Dim x As Slide
        Dim Abschnitt As String
        Dim Text(100) As String
            
        'Schleife über alle Folien um die Titel auszuleden
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text <> "Agenda" Then
                If Right(x.Shapes.Title.TextFrame.TextRange.Text, 2) <> "  " Then
                    If Text(x.sectionIndex) <> "" Then
                        Text(x.sectionIndex) = Text(x.sectionIndex) & Chr(10) & x.Shapes.Title.TextFrame.TextRange.Text
                        Else
                        Text(x.sectionIndex) = AgendaAbschnitte(x.sectionIndex) & Chr(10)
                        'MsgBox Text(x.sectionIndex)
                        Text(x.sectionIndex) = Text(x.sectionIndex) & x.Shapes.Title.TextFrame.TextRange.Text
                    End If
                End If
            End If
        Next
        
        'Einfügen der Agenda in die Folie
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text = "Agenda" Then
                x.Shapes.Placeholders(2).TextFrame.TextRange.Text = Text(x.sectionIndex)
            End If
        Next
    End Sub
    
    Function AgendaAbschnitte(Abschnitt As Integer) As String
        Dim a As Integer
        With ActivePresentation.SectionProperties
            For a = 1 To .Count
                If a = Abschnitt Then
                AgendaAbschnitte = "" & .Name(a) & " beinhaltet " & _
                 .SlidesCount(a) & " Folien"
                 End If
            Next a
        End With
    End Function

    Samstag, 3. Mai 2014 09:47
  • Hallo,

    Abschnitte gibt es in PP schön länger. Du erreichst sie z.B. über einen Rechtsklick zwischen den Folien in der Foliensortieransicht. Darin sollte die Funktion "Abschnitt hinzufügen" erscheinen. Über einen Rechtsklick auf den Abschnittsnamen kann dieser auch nachträglich geändert werden.

    Die Präsentation kann ich nicht hochladen, da sie fast 200 Folien hat. Deshalb brauche ich ja Hilfsmittel für die Organisation, wie z.B. Abschnitte oder auch die Benutzerorientierte Präsentation.

    Die Lösung habe ich gefunden, wie Du weiter unten lesen kannst.

    Gruß
    MIchael

    Samstag, 3. Mai 2014 09:51
  • Abschnitte gibt es in PP schön länger. Du erreichst sie z.B. über einen Rechtsklick zwischen den Folien in der Foliensortieransicht. Darin sollte die Funktion "Abschnitt hinzufügen" erscheinen. Über einen Rechtsklick auf den Abschnittsnamen kann dieser auch nachträglich geändert werden.

    Aha, danke für die Erläuterung, hab ich wieder was gelernt.

    Ganz universell gesehen muss man ja nur kucken in welchem Abschnitt jede Folie liegt und so das Ergebnis nach Abschnitten gruppieren.

    Wenn man dann einfach eine Tabelle macht, dann kann man je Zeile den Abschnitt/Titel/Folie ganz einfach erzeugen, auch mit einem Hyperlink.

    Ich nehme für sowas gerne das Scripting.Dictionary und packe als Element dann ein Collection (oder auch man weitere Dictionary's) rein.

    Andreas.

    Option Explicit
    
    #Const NurFolienMitTitel = False
    
    Sub Inhaltsverzeichnis()
    #If NurFolienMitTitel Then
      Const Spalten = 2
    #Else
      Const Spalten = 3
    #End If
      Dim SkipFirst As Boolean
      Dim SP As SectionProperties
      Dim SL As Slide
      Dim SH As Shape
      Dim TOC As Table
      Dim Dict As Object 'Scripting.Dictionary
      Dim SectionName As String
      Dim SectionNames, SectionItems
      Dim i As Long, j As Long, Count As Long
    
      'Folien nach Abschnitten sammeln
      Set SP = ActivePresentation.SectionProperties
      Set Dict = CreateObject("Scripting.Dictionary")
      Count = 0
      SkipFirst = True
      For Each SL In ActivePresentation.Slides
        If SkipFirst Then
          SkipFirst = False
          GoTo SkipSlide
        End If
    #If NurFolienMitTitel Then
        If Not SL.Shapes.HasTitle Then GoTo SkipSlide
    #End If
        SectionName = SP.Name(SL.sectionIndex)
        If Not Dict.Exists(SectionName) Then Dict.Add SectionName, New Collection
        Dict(SectionName).Add SL
        Count = Count + 1
    SkipSlide:
      Next
    
      'Tabelle mit Inhaltsverzeichnis erstellen
      Set SL = ActivePresentation.Slides(1)
      On Error Resume Next
      Set SH = SL.Shapes("TOC")
      On Error GoTo 0
      If Not SH Is Nothing Then SH.Delete
      Set SH = SL.Shapes.AddTable(Count + 1, Spalten)
      SH.Name = "TOC"
      Set TOC = SH.Table
      TOC.Cell(1, 1).Shape.TextFrame.TextRange.Text = "Abschnitt"
      TOC.Cell(1, 2).Shape.TextFrame.TextRange.Text = "Titel"
    #If Not NurFolienMitTitel Then
      TOC.Cell(1, 3).Shape.TextFrame.TextRange.Text = "Folie"
    #End If
    
      SectionNames = Dict.Keys
      SectionItems = Dict.Items
      Count = 2
      For i = 0 To UBound(SectionNames)
        'Abschnitt
        TOC.Cell(Count, 1).Shape.TextFrame.TextRange.Text = SectionNames(i)
        'Alle Folien dieses Abschnittes
        For Each SL In SectionItems(i)
          If SL.Shapes.HasTitle Then
            'Folie mit Titel
            With TOC.Cell(Count, 2).Shape.TextFrame.TextRange.Paragraphs(1)
              .Text = SL.Shapes.Title.TextFrame.TextRange.Text
              With .ActionSettings(ppMouseClick)
                .Action = ppActionHyperlink
                .Hyperlink.SubAddress = SL.SlideID & "," & SL.SlideIndex & "," & SL.Name
              End With
            End With
          Else
            'Unterfolie
            With TOC.Cell(Count, 3).Shape.TextFrame.TextRange.Paragraphs(1)
              .Text = SL.Name
              With .ActionSettings(ppMouseClick)
                .Action = ppActionHyperlink
                .Hyperlink.SubAddress = SL.SlideID & "," & SL.SlideIndex & "," & SL.Name
              End With
            End With
          End If
          Count = Count + 1
        Next
      Next
    End Sub
    
    

    Sonntag, 4. Mai 2014 14:46
  • Ich versuche Ihren Code zu nutzen um ein Inhaltsverzeichnis anzulegen.

    Jedoch hab ich bei der Zeile

    x.Shapes.Placeholders(2).TextFrame.TextRange.Text = Text(x.sectionIndex)

    das Problem, dass es hier zur Fehlermeldung "Laufzeitfehler Placeholders (unknown member): Integer ou of range. 2 is not in the valid range of 1 to 1." kommt und ich nicht weiß was das bedeutet.

    Können Sie mir weiterhelfen? Vielen Dank schonmal!

    Montag, 30. März 2015 10:42
  • Hallo Christoph,

    Du sprichst das dritte Element (Index 2, der Index ist wahrscheinlich nullbasiert) an. Es gibt aber nur ein Element, daher kannst Du maximal den Index 0 (erstes Element) oder 1 (wenn der Index nicht nullbasiert sein sollte) angeben.


    Gruß, Stefan
    Microsoft MVP - Visual Developer ASP/ASP.NET
    http://www.asp-solutions.de/ - Consulting, Development
    http://www.aspnetzone.de/ - ASP.NET Zone, die ASP.NET Community

    Montag, 30. März 2015 11:10
    Moderator
  • Hallo Stefan,

    vielen Dank für deine schnelle Antwort!

    Jetzt klappt die Erzeugung des Inhaltsverzeichnisses. Diese erfolgt jetzt aber in dem Textfeld, wo vorher Agenda stand. Ich will aber, dass das Inhaltsverzeichnis im Textfeld darunter erzeugt wird. Wie mache ich das?

    Könntest du mir vielleich mal erklären was die einzelnen Wörter in der Zeile bedeuten?

    Viele Grüße

    Christoph


    Montag, 30. März 2015 11:55
  • Hallo Christian,

    ich habe damals mehr als eine reine Auflistung der Folien benötigt. Aus diesem Grund pass der Code vielleicht nicht ganz. Der nachfolgende Code läuft bei mir.

    Das Verzeichnis wird hier in 2 Schritten erstellt.

    1. in der ersten Schleife werden die Überschriften alle Folien gelesen und pro Abschnitt in ein Array geschrieben.

    2. die 2. Schleife schreibt den Inhalt pro Abschnitt in die dafür vorgesehenen Objekte. Vielleicht ist bei Dir dieses Zielobjekt nicht vorhanden! das könnte den Fehler erklären, da mein Code kein Objekt erstellt.

    Gruß

    Michael

    Sub Inhaltsverzeichnis()
        Dim x As Slide
        Dim Abschnitt As String
        Dim Text(100) As String
            
        'Schleife über alle Folien um die Titel auszuleden
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text <> "Agenda" Then
                If Right(x.Shapes.Title.TextFrame.TextRange.Text, 2) <> "  " Then
                    If Text(x.sectionIndex) <> "" Then
                        Text(x.sectionIndex) = Text(x.sectionIndex) & Chr(10) & x.Shapes.Title.TextFrame.TextRange.Text
                        Else
                        Text(x.sectionIndex) = AgendaAbschnitte(x.sectionIndex) & Chr(10)
                        'MsgBox Text(x.sectionIndex)
                        Text(x.sectionIndex) = Text(x.sectionIndex) & x.Shapes.Title.TextFrame.TextRange.Text
                    End If
                End If
            End If
        Next
        
        'Einfügen der Agenda in die Folie
        For Each x In ActivePresentation.Slides
            If x.Shapes.Title.TextFrame.TextRange.Text = "Agenda" Then
                x.Shapes.Placeholders(2).TextFrame.TextRange.Text = Text(x.sectionIndex)
            End If
        Next
    End Sub

    Montag, 30. März 2015 12:27
  • Was hast du denn für ein Zielobjekt gehabt, in dass das Inhaltsverzeichnis geschrieben wurde? Mit meinem normalen Textfeld funktioniert es nicht.
    Montag, 30. März 2015 13:55
  • ich habe aus dem Folienlayout das Aufzählobjekt benutzt.
    Montag, 30. März 2015 14:00
  • Hallo,

    ich habe das gleiche Problem und habe jetzt deine Antwort gefunden und in das Makromodul eingefügt.

    ... und jetzt ...?

    Makro Ausführen gibt mir keine Aktion.

    Ich habe die Abschnitte benannt und habe PPT in der Makro-Version gespeichert, Makros aktiviert, ... da ich so gut wie nicht mit Makros arbeite, sondern vorzugsweise mit internen Funktionen arbeite -- @ Microsoft: Warum gibt es das automatische Inhaltsverzeichniserstellen nicht mehr ? -- bekomme ich Deinen Code nicht dazu, dass mir ein Inhaltsverzeichnis gebastelt wird...

    Kannst Du mir da vielleicht noch einen Tipp geben? Mit Folienlayout Aufzählobjekt komme ich nicht weiter - was soll das sein? gibt es bei mir nicht...?!

    Danke für Deine Hilfe!

    Mittwoch, 9. August 2017 08:19
  • ich habe das gleiche Problem und habe jetzt deine Antwort gefunden und in das Makromodul eingefügt.

    ... und jetzt ...?

    Makromodul? Hmm... hast Du Alt-F11 gedrückt, dann im Menü Einfügen\Modul ein reguläres Modul erzeugt und es da rein kopiert?

    Dann VBA Editor zu, in Powerpoint Alt-F8 drücken und ausführen.

    Andreas.

    Mittwoch, 9. August 2017 16:27