Power Point Afficher progressivement le texte d'un tableau

Sub AffichageProgressifDepuisTableau()
    Dim ws As Worksheet
    Dim sourceRange As Range
    Dim destRange As Range
    Dim i As Integer, j As Integer
    Dim delay As Double

    ' Définir la feuille de travail active (ou spécifier une feuille spécifique)
    Set ws = ActiveSheet

    ' Définir la plage source contenant le texte à afficher (A1:J2)
    Set sourceRange = ws.Range("A1:J2")
    
    ' Définir la plage de destination pour l'affichage progressif (par exemple, A5:J6)
    Set destRange = ws.Range("A5:J6")

    ' Temps de délai en secondes
    delay = 1

    ' Parcourir chaque cellule de la plage source et copier le contenu dans la plage de destination
    For i = 1 To sourceRange.Rows.Count
        For j = 1 To sourceRange.Columns.Count
            ' Afficher le contenu de la cellule source dans la cellule de destination correspondante
            destRange.Cells(i, j).Value = sourceRange.Cells(i, j).Value
            
            ' Temporisation pour l'affichage progressif
            Application.Wait (Now + TimeValue("0:00:" & delay))
        Next j
    Next i
End Sub

Sub AffichageProgressifDansMemeDiapositive()
    Dim ppt As Object
    Dim pres As Object
    Dim slide As Object
    Dim tbl As Object
    Dim i As Integer, j As Integer
    Dim delay As Double

    ' Temps de délai en secondes
    delay = 0.5

    ' Définir l'application PowerPoint et la présentation active
    Set ppt = CreateObject("PowerPoint.Application")
    Set pres = ppt.ActivePresentation

    ' Définir la diapositive contenant le tableau
    Set slide = pres.Slides(1) ' Par exemple, la diapositive 1

    ' Définir le tableau
    Set tbl = slide.Shapes(1).Table ' Assurez-vous que le tableau est le premier shape de la diapositive

    ' Boucle pour afficher progressivement le contenu du tableau
    For i = 1 To tbl.Rows.Count
        For j = 1 To tbl.Columns.Count
            ' Rendre la cellule visible
            tbl.Cell(i, j).Shape.TextFrame.TextRange.Text = tbl.Cell(i, j).Shape.TextFrame.TextRange.Text
           
            ' Temporisation pour l'affichage progressif
            WaitFor delay
        Next j
    Next i
End Sub

Private Sub WaitFor(delay As Double)
    Dim startTime As Double
    startTime = Timer
    Do While Timer < startTime + delay
        DoEvents
    Loop
End Sub

Dim cellRow As Integer
Dim cellColumn As Integer

Sub InitializeProgressiveDisplay()
    ' Initialize starting cell position
    cellRow = 1
    cellColumn = 1
End Sub

Sub DisplayNextCell()
    Dim ppt As Object
    Dim pres As Object
    Dim slide As Object
    Dim tbl As Object

    ' Définir l'application PowerPoint et la présentation active
    Set ppt = Application
    Set pres = ppt.ActivePresentation

    ' Définir la diapositive contenant le tableau
    Set slide = pres.Slides(1) ' Par exemple, la diapositive 1

    ' Définir le tableau
    Set tbl = slide.Shapes(1).Table ' Assurez-vous que le tableau est le premier shape de la diapositive

    ' Vérifier si nous sommes toujours dans les limites du tableau
    If cellRow <= tbl.Rows.Count And cellColumn <= tbl.Columns.Count Then
        ' Rendre la cellule visible
        tbl.Cell(cellRow, cellColumn).Shape.TextFrame.TextRange.Text = tbl.Cell(cellRow, cellColumn).Shape.TextFrame.TextRange.Text

        ' Avancer à la cellule suivante
        cellColumn = cellColumn + 1
        If cellColumn > tbl.Columns.Count Then
            cellColumn = 1
            cellRow = cellRow + 1
        End If
    End If
End Sub