Bonjour le forum,

j'ai un souci dans une macro qui génère un diaporama powerpoint depuis une feuille excel :
le tableau dans le slide PPT contient :
5 lignes dont :
  • 3 d'une seule cellule
  • 1 ligne avec 2 cellules
  • 1 ligne avec 3 cellules

lorsque je lance la macro, elle met toujours le message d'erreur :
"erreur d'exécution '-2147188160(80048240)' :
Table.Cell : integer out of range. 4 is not in Row's valid range of 1 to 1"
j'avoue ne pas saisir pourquoi il ne lit pas les différentes lignes du tableau
voici le code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub PPT()
Dim objPPT As Object
Dim objPres As Object
Dim objSld As Object
Dim objShp As Object
Dim Rg As Range
 
'sélection de la zone de données à fusionner
With Sheets("description-prod")
    Tablo = Range("A2:N" & Range("N65000").End(xlUp).Row).Value
End With
 
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
 
Set objPres = objPPT.Presentations.Open(ThisWorkbook.Path & "\DEVIS-PPT1.pptx")
objPres.SaveAs ThisWorkbook.Path & "\testdevis.pptx"
 
'recherche de la dernière cell M
With Worksheets("description-prod")
  Set Rg = .Range("M2:M" & Range("M65000").End(xlUp).Row)
End With
 
'si la cell M est différente de 0, alors fusion entre Excel et Ppt
 
  Do Until ActiveCell = ""
 
    If ActiveCell <> 0 Then
For i = 1 To UBound(Tablo)
    Set objSld = objPres.Slides(1).Duplicate
    For Each objShp In objSld.Shapes
        If objShp.HasTable Then
            With objShp.Table
                X = X + 1
                .cell(1, 1).Shape.TextFrame.TextRange.Text = Tablo(X, 13)
                .cell(4, 1).Shape.TextFrame.TextRange.Text = Tablo(X, 6)
                .cell(4, 2).Shape.TextFrame.TextRange.Text = Tablo(X, 7)
                .cell(5, 2).Shape.TextFrame.TextRange.Text = Tablo(X, 11)
                .cell(5, 3).Shape.TextFrame.TextRange.Text = Tablo(X, 12)
            End With
        End If
    Next
Next
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Loop
objPres.Slides(1).Delete
objPres.save
objPres.Close
 
End Sub
une idée sur ce qui provoque le problème ?
d'avance merci