Problème de lignes dans un tableau en VBA

Version imprimable

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:

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

17/01/2011, 10h19
Jean-Philippe André

salut,

je comprends pas trop les syntaxes de certaines lignes :

ActiveCell.Offset(1, 0).Range("A1").Select

me parait un peu capillotracte :aie:

Sinon, vois si les boucles ne vont pas de
0 a UBound()-1
au lieu de
1 a UBound()
17/01/2011, 10h26
pgz
Bonjour.

Tu n'es peut-être pas sur la bonne table dans ppt. Comme tu utilises un slide modèle, tu pourrais nommer les objets qui t'intéressent.

Par ailleurs, j'ai remarqué :
- des variables non déclarées :Tablo, X
- une boucle For Next, compteur = i, mais i n'est pas utilisé dans la boucle
Cordialement,

PGZ
17/01/2011, 12h29
fidecourt

bon j'ai du mal...
voici la boucle que je veux faire :
si M <> 0 alors création d'un slide depuis le modèle DEVIS-PPT1.pptx
remplissage du tableau
et tant que B = M
alors ajoute les lignes 4 et 5 du tableau avec les infos de la ligne
jusqu'à ce que M soit différent de B
en fait dans la colonne M se trouve le titre du tableau
ensuite les produits et quantité qui constituent le tableau
===
je joins un fichier exemple, peut être pouvez vous m'aiguiller sur la meilleure façon de faire
d'avance merci:cry: