liaison excel - powerpoint

Sub Extract_Excel()
  Dim appXL As Excel.Application
  Dim claXL As Excel.Workbook
  Dim presPPT As PowerPoint.Presentation
  Dim Diapo As PowerPoint.Slide
  Dim i As Integer
  
  'presPPT représente la présentation active
  Set presPPT = ActivePresentation
  'Créer une nouvelle instance de l'application Excel
  Set appXL = New Excel.Application
  'Créer un nouveau classeur dans cette instance
  Set claXL = appXL.Workbooks.Add
  'Commencer en ligne 2 dans Excel
  i = 2
  
  'Boucle sur les diapositives de la présentation
  For Each Diapo In presPPT.Slides
    With appXL
      'Ecrire le titre en colonne A
      .Cells(i, 1) = Diapo.Shapes.Title.TextFrame.TextRange.Text
      'Ecrire l'index en colonne B
      .Cells(i, 2) = Diapo.SlideIndex
      'Ligne suivante dans Excel
      i = i + 1
    End With
  Next

  'Afficher le classeur Excel
  appXL.Visible = True
  
End Sub

  For Each Diapo In presPPT.Slides
    With appXL
      'Ecrire le titre en colonne A
      .Cells(i, 1) = Diapo.Shapes(#).TextFrame.TextRange.Text
      'Ligne suivante dans Excel
      i = i + 1
    End With
  Next

Sub Extract_Excel()
On Error Resume Next
  Dim appXL As Excel.Application
  Dim claXL As Excel.Workbook
  Dim presPPT As PowerPoint.Presentation
  Dim Diapo As PowerPoint.Slide
  Dim Forme As PowerPoint.Shape
  Dim i As Integer 'ligne
  Dim j As Integer 'colonne
  
  'presPPT représente la présentation active
  Set presPPT = ActivePresentation
  'Créer une nouvelle instance de l'application Excel
  Set appXL = New Excel.Application
  'Créer un nouveau classeur dans cette instance
  Set claXL = appXL.Workbooks.Add
  'Commencer en ligne 2 dans Excel
  i = 2
  
  'Boucle sur les diapositives de la présentation
  For Each Diapo In presPPT.Slides
    'Commencer en colonne 3 pour les zones de texte
    j = 3
    With appXL
      'Ecrire le titre en colonne A
      .Cells(i, 1) = Diapo.Shapes.Title.TextFrame.TextRange.Text
      'Ecrire l'index en colonne B
      .Cells(i, 2) = Diapo.SlideIndex
      For Each Forme In Diapo.Shapes
'        If Forme.Type = msoTextBox Then
        .Cells(i, j) = Left(Forme.TextFrame.TextRange.Text, 255)
        j = j + 1
'        End If
      Next
      'Ligne suivante dans Excel
      i = i + 1
    End With
  Next

  'Afficher le classeur Excel
  appXL.Visible = True
  
End Sub