Suche Lösung für eine Aufgabenstellung in PowerPoint

Dazu musst Du zuerst mal die Registerkarte Entwicklertools im Menüband aktivieren.

https://support.office.com/de-de/ar...lertools-e1192344-5e56-4d45-931b-e5fd9bea2d45

Dann machst Du Dir auf der Folie ein "Scroll Bar (ActiveX Control)" am linken oder rechten Rand.

Ich gehe davon aus das auf der gleichen Folie auch eine gezeichnete Tabelle drin ist, so wie es Dein Bild zeigt.

Nun klickst Du mit der rechten Maustaste auf diese Scrollbar und wählst "Code anzeigen" (ggf. musst Du ein 2tes Mal klicken, falls er zuerst das Shape aktiviert gibt es nur 3 Menüpunkte Verschieben, Kopieren, Abbrechen).

In den VBA Editor kopierst Du diesen Code:

--- schnipp ---

Option Explicit

Dim Table As Shape

Dim ViewHeight As Single

Const Space = 20

Private Sub ScrollBar1_Change()

  If Table Is Nothing Then Exit Sub

  Table.Top = Space + (ViewHeight - Table.Height) / Table.Table.Rows.Count * Me.ScrollBar1.Value

End Sub

Private Sub ScrollBar1_GotFocus()

  Dim ThisSlide As Slide

  Set ThisSlide = ActiveSlide

  For Each Table In ThisSlide.Shapes

    If Table.Type = msoTable Then Exit For

  Next

  ViewHeight = ThisSlide.Master.Height - 2 * Space

  If Table Is Nothing Then

    MsgBox "Keine Tabelle vorhanden"

    Exit Sub

  End If

  With Me.ScrollBar1

    .Min = 0

    .Max = Table.Table.Rows.Count

    .LargeChange = .Max / Table.Height * ViewHeight

  End With

End Sub

--- schnapp ---

Dann klickst Du im VBA Editor auf Einfügen \ Modul und dort kopierst Du diesen Code rein:

--- schnipp ---

Option Explicit

Function ActiveSlide() As Slide

  On Error Resume Next

  'Design time

  Set ActiveSlide = ActiveWindow.View.Slide

  If ActiveSlide Is Nothing Then

    'Run time

    Set ActiveSlide = ActivePresentation.SlideShowWindow.View.Slide

  End If

End Function

--- schnapp ---

VBA Editor schließen

Datei \ Speichern Unter \ als Präsentation mit Makros .pptm abspeichern

Das war's. Starte die Präsentation und klick zuerst mal auf einen Knopf, oben oder unten, dann stellt der Code die Scrollbar passend zu der Tabelle ein. Und nun kannst Du per Klick ganz normal scrollen, wie Du es von anderen Programmen auch gewohnt bist.

Andreas.

Also zum einen kannst Du "einfach klicken", es sind ja 2 Button an jedem Ende.

Zum anderen hätte ein einfacher CommandButton den Nachteil das Du nur runterscrollen kannst.

Der Witz, den Du wahrscheinlich noch nicht bemerkt hast, ist, das die Tabelle an der gescrollten Stelle bleibt, auch beim Beenden der Präsentation. Mit einem Scrollbar kannst Du vor und zurück und auch bei einer Nachfrage später nochmals zurückblättern und
kannst auf die entsprechende Stelle scrollen. Mit einem einfachen Button bist Du aufgeschmissen.

Wie viel gescrollt wird, das kann / muss man selber berechnen:

Table.Top = Space + (ViewHeight - Table.Height) / Table.Table.Rows.Count * Me.ScrollBar1.Value

Wobei "Table.Table.Rows.Count" die Anzahl der Zeilen in der Tabelle sind und Me.ScrollBar1.Value der aktuelle Wert ist.

Wenn da nun Zellen drin sind die mehrere Zeilen haben, dann muss dieser Wert entsprechend höher werden.

Das läßt sich automatisieren, man kann die Zeilenumbrüche pro Zeile zählen und wenn man die Tabelle komplett durchlaufen hat ist das Ergebnis der "visuellen Zeilenanzahl" bekannt.

Wenn Du trotzdem einen einfachen CommandButton willst, dann deklariere eine globale Variable

Dim Position As Long

und berechne

Table.Top = Space + (ViewHeight - Table.Height) / TableRows * Position

Position = Position + 1

Und anstatt

Private Sub ScrollBar1_Change()

Private Sub ScrollBar1_GotFocus()

heißt es dann

Private Sub CommandButton1_Click()

Private Sub CommandButton1_GotFocus()

Andreas.

Option Explicit

Dim Table As Shape

Dim ViewHeight As Single, TableRows As Long

Const Space = 20

Private Sub ScrollBar1_Change()

  If Table Is Nothing Then Exit Sub

  Table.Top = Space + (ViewHeight - Table.Height) / TableRows * Me.ScrollBar1.Value

End Sub

Private Sub ScrollBar1_GotFocus()

  Dim ThisSlide As Slide

  Set ThisSlide = ActiveSlide

  For Each Table In ThisSlide.Shapes

    If Table.Type = msoTable Then Exit For

  Next

  ViewHeight = ThisSlide.Master.Height - 2 * Space

  If Table Is Nothing Then

    MsgBox "Keine Tabelle vorhanden"

    Exit Sub

  End If

  Dim R As Row, C As Cell

  Dim m As Long, i As Long

  TableRows = 0

  For Each R In Table.Table.Rows

    m = 0

    For Each C In R.Cells

      i = UBound(Split(C.Shape.TextFrame2.TextRange.Text, vbVerticalTab)) + 1

      If i > m Then m = i

    Next

    TableRows = TableRows + m

  Next

  With Me.ScrollBar1

    .Min = 0

    .Max = TableRows

    .LargeChange = .Max / Table.Height * ViewHeight

  End With

End Sub

Hallo Andreas,

danke für Deine schnelle super Unterstützung - das kommt schon ganz nahe an das was ich umsetzen möchte. Da hast Du mir sehr geholfen.

Für das Sahnehäubchen sind mir noch 2 Sachen in den Sinn gekommen.

Vielleicht hast Du noch eine Idee:

• Kann ich die Scrollbar ersetzen durch ein Steuerelement auf das ich nur "Klicken" muss - oder die Returntaste drücke?
  
  (dann kann ich das auch leichter mit einem "Presenter" fernsteueren...)
• Kann ich festlegen, das immer um eine Tabellenzeile "gescrollt" wird, auch wenn in diesen Zeilen mehrzeiliger Text steht?(dann könnte ich bei der Präsentation meinen "Sprechtext" super darauf abstimmen...

Viele Grüße

Hallo Andreas,

Danke Danke !!!

Ja Du hast mit Deinen Anmerkungen recht.

Ich kann nun für mich das Beste mal ausprobieren.

Danke nochmals.

hatte heute die gleiche Aufgabenstellung und konnte durch einen Kollegen (Exchange Experte) die Lösung finden:

Voraussetzung für die Tabellenausgabe ist im Kalender die Ansicht auf "Liste" zu ändern.

Dann die gewünschte Suche durchführen und Ausdruck im Tabellenformat durchführen.

Zu druckende Zeilen zuvor markieren und bei Druckoptionen "nur markierte Zeilen" auswählen.

schöne Grüße