Discussion :

[Finalflap]

Bonjour/Bonsoir,

Je suis nouveau sur le forum et en VBA aussi. Je sollicite votre aide pour finaliser ma macro.
Le but est d'exporter des tableaux excel selon different critères, les critères sont choisis dans une listbox et ensuite exporter vers un ppt.

Par la suite j'ai voulu rajouter une mise en forme car les tableaux sont automatiquement coller sur ppt en police 4, ce qui est illisible. La solution que j'ai trouve c'est un pastespecial en image mais le rendu est pas aussi bien que le paste normal+changement de taille de police manuellement.

Et j'ai voulu indiquer un chemin relatif pour l'ouverture du powerpoint, et la c'est le drame, ma commande paste ne marche plus.
J'ai toute les fonctionalites que je veux integrer dans mon code mais qui ne marchent pas ensemble.

Pouvez-vous m'aider a finaliser le code, je pense que c'est un problème de syntaxe ou d'objet.

Ci-joint les fichiers en questions.
ListBox Test.xlsmTemplate.ppt.zip

Merci d'avance pour votre aide.

Finalflap

[Menhir]

Il y a déjà eu des demandes similaires.
Essaye de lancer une recherche sur le terme "powerpoint" en limitant la recherche aux rubriques Excel et VBA Excel.

[Finalflap]

Bonjour,
Menhir merci beaucoup pour ta réponse suite à une recherche, j'ai trouvé un code qui règle partiellement mon probleme de commande pastespecial http://www.developpez.net/forums/d11...oujours-actif/.
J'arrive maintenant à copier un seul tableau sur le ppt indiqué grace au chemin relatif, mais ça me copie pas tout les tableaux et ça me met une erreur d'éxécution à la ligne de ma commande pastespecial:

ShapeRange (unknown member): Invalid request. To select a shape, it's view must be active.

D'avance merci pour votre aide

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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Sub Export()
Dim ppt As PowerPoint.Application
Dim PPTDOC As PowerPoint.Presentation
Dim pptApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim j, NbreLigne As Long
Dim Tableau
Dim Chantier As String
Dim ObjShTable As PowerPoint.Shape
 
 
  If Range("A4") = "" Then
    MsgBox "Aucune sélection"
    Exit Sub
  End If
 
  Application.ScreenUpdating = False
  Tableau = Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
 
  ' On vérifie si on a un critère de la ListBox1
    If Range(Sheets("Sheet1").ListBox1.LinkedCell) <> "" Then
            Chantier = Range(Sheets("Sheet1").ListBox1.LinkedCell)
    End If
 
  ' On se lie avec le PPT ouvert
Set pptApp = CreateObject("PowerPoint.application")
pptApp.Visible = True
'Set PPTDOC = PPTApp.Presentations.Add(msoTrue)
Set PPTDOC = pptApp.Presentations.Open(ThisWorkbook.Path & "\template.pptx")
 
 
 
  Sheets("Trajectoire").Select
  NbreLigne = Range("A" & Rows.Count).End(xlUp).Row       ' Nombre de ligne du tableau page "Trajectoire"
 
  ' Ce filtre ne change pas alors on le place en dehors de la boucle
            ActiveSheet.Range("$A$10:$P$" & NbreLigne).AutoFilter Field:=16, Criteria1:=Array("A", "B", "C", "D"), Operator:=xlFilterValues
 
  ' Ce filtre ne change pas alors on le place en dehors de la boucle
            ActiveSheet.Range("$A$10:$P$" & NbreLigne).AutoFilter Field:=2, Criteria1:=Chantier
  Columns("F").Hidden = True
 
    For j = 1 To UBound(Tableau)
            ActiveSheet.Range("$A$10:$P$" & NbreLigne).AutoFilter Field:=11, Criteria1:=Tableau(j, 1)
 
                 If Application.Subtotal(103, Range("A11:A" & NbreLigne)) > 0 Then   ' Vérif si des lignes filtrées
                    'pptapp.ActivePresentation.Slides(J - 2).Select
 
                            'rajoute 1 slide
                        pptApp.ActivePresentation.Slides.Add pptApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
                    pptApp.ActiveWindow.View.GotoSlide pptApp.ActivePresentation.Slides.Count
 
                            'Copier la selection
                            Sheets("Trajectoire").Range("A10:K" & NbreLigne).SpecialCells(xlCellTypeVisible).Copy
 
 
                            With pptApp.ActivePresentation
                            '.Activate
                            pptApp.ActivePresentation.Slides(2).Select
                            pptApp.ActivePresentation.Slides(2).Shapes.PasteSpecial(ppPasteDefault, link:=True).Select
                            End With
 
                             With Selection
                        .Font.Size = 9
                        .Left = 120
                        .Top = 100
                        .Height = 500
                        .Width = 700
                        .LockAspectRatio = msoTrue
                        '.ScaleHeight ScaleFctr, True
                        '.ScaleWidth ScaleFctr, True
                        .Align msoAlignCenters, True
                        .Align msoAlignMiddles, True
 
                        End With
End If
        Next j
 
  ActiveSheet.AutoFilterMode = False
  Columns("F").Hidden = False
  Application.CutCopyMode = False
 
End Sub

[clementmarcotte]

Bonjour,

Désolé, mais chez-moi tes Listboxes sont désespérément vides, et il n'y a aucune indication sur la façon de les remplir.

La seule chose que je peux donc dire, c'est de remplacer le ppLayoutBlank de cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  pptApp.ActivePresentation.Slides.Add pptApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank

par sa valeur numérique.

Tu devrais avoir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

PPTApp.ActivePresentation.Slides.Add PPTApp.ActivePresentation.Slides.Count + 1, 12

Pour le reste, je n'ai pas le temps, ni la boule de cristal pour deviner ce qui est supposé être dans les listboxes.

Et puis, c'est quoi la référence manquante : imkrudt.dll ?

[Finalflap]

Bonjour,

D'abord merci de t'être penche sur mon problème, et désolé de répondre aussi tardivement.

La listbox sert a definir des criteres de selection suivant les choix fait, la macro sélectionne les données a copier/coller sur ppt. Le code de la listbox est contenue dans la sheet1.
Je pense savoir pourquoi tu as des probleme avec la listbox et la reférence manquante. Je viens de regarder chez moi sur mon ordi perso qui est un mac, et j'ai les meme probleme que toi, que je n'ai pas au bureau, mais au bureau je ne peux pas me connecter au forum.

Pour la ligne de code avec la valeur numerique je n'ai pas encore essayé, je te tiens au courant jeudi quand je rentre au bureau.

Encore merci,

Finalflap

[Finalflap]

Bonjour,

Désolé pour le double post.
Pour répondre à clementmarcotte, les refs que j'ai sont .

Le résultat que j'avais avec l'adresse absolue Présentationtest.zip. Le fichier qui permet d'avoir ce résultat ListBox V003.xlsm.

Avec l'ajout de l'adresse relative ListBox V005.xlsm, et le résultat que j'ai maintenant template2.zip.

Voila j'espere que ca vous aidera à voir plus clair.

Merci,

Finalflap