VBA erreur de compilation procédure trop grande

michel90 · 5 Avril 2017

Bonjour,
j'ai un léger problème dans ma macro, et j'aimerais que quelqu'un puisse m'aider SVP.

la macro ce dessous permet d’afficher le contenue des cellule d'un fichier excel sur les slides d'un PowerPoint.

VB:

Private Sub import()
'ce programme  sert a ouvrir le powerpoint cartes support relais et mettre a jour les slide c'est a dire les commentaire ainsi ETAT des relais.

Dim pptapp As PowerPoint.Application
'Dim PptDoc As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim Shp As PowerPoint.Shape
'Dim Cs1 As ColorScheme
'Dim NbShpe As Integer
Set pptapp = CreateObject("Powerpoint.Application")

Dim presppt As PowerPoint.Presentation
Dim FichierPpt, pwpt
Set pwpt = CreateObject("PowerPoint.Application")
'pwpt.Visible = False


Set presppt = pptapp.Presentations.Open(Filename:="Y:\Pré-op\SOPP et relais\Relais\Situation Relais V2\cartes support relais.pptm")

'pwpt.Visible = True
pwpt.ActivePresentation.UpdateLinks
With presppt
    '--- Ajoute un Slide
' .Slides.Add Index:=1, Layout:=ppLayoutBlank
  'Crée une zone de texte (AddLabel)
  ' affectation à l'objet slide la première diapositive de la présentation en cours.

    ' création de la zone de texte
   Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 70, 320, 600, 50)
 
    'insère la valeur de la Cellule E3 dans une zone de texte (Le commentaire)
  If Range("E3") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E3")
 
    'Modifie la couleur du texte
  Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
 
  
  
'--------com1-SOMAIN
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 240, 350, 50)
     If Range("E53") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E53")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com2
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 220, 350, 50)
     If Range("E52") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E52")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com3
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 200, 350, 50)
     If Range("E51") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E51")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com4
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 180, 350, 50)
     If Range("E50") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E50")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com5
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 160, 350, 50)
     If Range("E49") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E49")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com6
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 140, 350, 50)
      If Range("E48") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E48")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '-------Etat somain
Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)
      If Range("D3") <> 0 Then Shp.TextFrame.TextRange.Text = Range("D3")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
    End With
'-------------------------------------------------------------------------------------------

With presppt
   ' création de la zone de texte
   Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 70, 320, 600, 50)
    'insère la valeur de la Cellule E4 dans une zone de texte (Le commentaire)
  If Range("E4") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E4")
    'Modifie la couleur du texte
  Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
  '-------------Com1-CULMONT CHALANDRY
  Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 240, 350, 50)
     If Range("E61") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E61")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com2
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 220, 350, 50)
     If Range("E60") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E60")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com3
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 200, 350, 50)
     If Range("E59") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E59")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com4
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 180, 350, 50)
     If Range("E58") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E58")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com5
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 160, 350, 50)
     If Range("E57") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E57")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com6
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 140, 350, 50)
      If Range("E56") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E56")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
      '-------Etat culmont
Set Shp = .Slides(3).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)
      If Range("D4") <> 0 Then Shp.TextFrame.TextRange.Text = Range("D4")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
    End With

With presppt
    ' création de la zone de texte
   Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 70, 320, 600, 50)
    'insère la valeur de la Cellule E5 dans une zone de texte (Le Commentaire)
  If Range("E5") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E5")
    'Modifie la couleur du texte
  Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
'------------com1-HAUSBERGEN
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 240, 350, 50)
     If Range("E69") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E69")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com2
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 220, 350, 50)
     If Range("E68") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E68")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com3
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 200, 350, 50)
     If Range("E67") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E67")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com4
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 180, 350, 50)
     If Range("E66") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E66")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com5
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 160, 350, 50)
     If Range("E65") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E65")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
     '--------com6
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 140, 350, 50)
      If Range("E64") <> 0 Then Shp.TextFrame.TextRange.Text = Range("E64")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
        '-------Etat hausbergen
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)
      If Range("D5") <> 0 Then Shp.TextFrame.TextRange.Text = Range("D5")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
    End With
presppt.Close
    Set presppt = Nothing
    pptapp.Quit
    Set pptapp = Nothing
End Sub

quand j'ajoute ce bout de code dans chaque slide qui permet d’afficher juste le contenu d'une cellule . ça me génère un erreur : la procédure est trop grande.

VB:

     '-------Etat hausbergen
Set Shp = .Slides(4).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)
      If Range("D5") <> 0 Then Shp.TextFrame.TextRange.Text = Range("D5")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)

quelqu'un peut m'aider a régler ce problème SVP.

Compte Supprimé 979 · 7 Avril 2017

Bonjour Michel90

Juste une question comme ça, pourquoi ne pas copier/coller avec liaison les cellules du fichier excel dans ton powerpoint !?

Sinon voici un exemple de code optimisé

VB:

Private Sub import()
  'ce programme  sert a ouvrir le powerpoint cartes support relais et mettre a jour les slide c'est a dire les commentaire ainsi ETAT des relais.
  Dim PptApp As PowerPoint.Application
  Dim PresPpt As PowerPoint.Presentation
  Dim Shp As PowerPoint.Shape
  Dim Sld As PowerPoint.Slide
  Dim FichierPpt As String
  Dim Ind As Integer, NumSld As Integer
  Dim TabCel() As String, TabTop() As String, TabHeight() As String
  Dim Top As Integer, Height As Integer
  ' Définir l'objet
  Set PptApp = CreateObject("Powerpoint.Application")
  ' Fichier powerpoint pour mon test
  FichierPpt = ThisWorkbook.Path & "\Michel90_Présentation1.pptx"
  ' Sinon le vrai chemin
  'FichierPpt = "Y:\Pré-op\SOPP et relais\Relais\Situation Relais V2\cartes support relais.pptm"
  Set PresPpt = PptApp.Presentations.Open(Filename:=FichierPpt)
  'pwpt.ActivePresentation.UpdateLinks
  With PresPpt
    '--- Ajoute un Slide
    ' .Slides.Add Index:=1, Layout:=ppLayoutBlank
    For NumSld = 2 To 4
      ' Définir la zone de texte
      Set Shp = .Slides(NumSld).Shapes.AddTextbox(msoTextOrientationHorizontal, 70, 320, 600, 50)
      'insère la valeur de la Cellule E3 dans une zone de texte (Le commentaire)
      If Range("E" & 1 + NumSld) <> 0 Then Shp.TextFrame.TextRange.Text = Range("E" & 1 + NumSld)
      'Modifie la couleur du texte
      Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
      ' Définir le tableau des Slide
      If NumSld = 2 Then TabCel = Split("D3,E48,E49,E50,E51,E52,E53", ",")
      If NumSld = 3 Then TabCel = Split("D4,E56,E57,E58,E59,E60,E61", ",")
      If NumSld = 4 Then TabCel = Split("D5,E64,E65,E66,E67,E68,E69", ",")
      '
      TabTop = Split("100,140,160,180,200,220,240", ",")
      TabHeight = Split("40,50,50,50,50,50,50", ",")
      ' Créer les textbox
      For Ind = 0 To UBound(TabCel)
        Top = Val(TabTop(Ind)): Height = Val(TabHeight(Ind))
        Set Shp = .Slides(NumSld).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, Top, 350, Height)
        If Range(TabCel(Ind)) <> 0 Then Shp.TextFrame.TextRange.Text = Range(TabCel(Ind))
        Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
      Next Ind
      '
    Next NumSld
  End With
  PresPpt.Close
  Set PresPpt = Nothing
  PptApp.Quit
  Set PptApp = Nothing
End Sub

A+

Lone-wolf · 7 Avril 2017

Bonjour Bruno

C'est la première fois que j'utilise excel avec powerpoint, la macro copie bien les cellules dans celui-ci n'est pas? . En faisant un test j'ai ce message d'erreur

Tu vois de quoi il s'agit?

michel90 · 7 Avril 2017

Bonjour Bruno, d'abord je te remercie pour ta réponse.
en effet j'ai utilisé le collage avec liaison, j'ai carrément zappé cette solution.
concernant le code. je vais l’essayer puis je te tiendrais au courant. merci encore

Compte Supprimé 979 · 7 Avril 2017

Salut Lone-wolf,

Lone-wolf à dit:
Bonjour Bruno
C'est la première fois que j'utilise excel avec powerpoint, la macro copie bien les cellules dans celui-ci n'est pas? . En faisant un test j'ai ce message d'erreur
Regarde la pièce jointe 987356
Tu vois de quoi il s'agit?

Personnellement, je n'utiliserais pas cette solution
Il est tellement plus simple de copier/coller des plages Excel avec liaisons
Une mise à jour dans Excel est automatiquement reproduite dans Powerpoint

Sinon pour le code, si les slide 2 à 4 n'existent pas, tu as l'erreur

A+

michel90 · 7 Avril 2017

BrunoM45 à dit:
Salut Lone-wolf,

Personnellement, je n'utiliserais pas cette solution
Il est tellement plus simple de copier/coller des plages Excel avec liaisons
Une mise à jour dans Excel est automatiquement reproduite dans Powerpoint

Sinon pour le code, si les slide 2 à 4 n'existent pas, tu as l'erreur

A+

Moi si j'ai utilisé cette solution car j'ai des cellules qui contiennent de gros commentaires! parfois des paragraphes. donc avec le collage avec liaison c'est très moche et le texte ne s'affiche pas au complet.

Lone-wolf · 7 Avril 2017

Re Bruno

Les Slides ce sont les diapos? Sinon pour la 2ème solution, comment on fait?

EDIT: bonjour Michel

Compte Supprimé 979 · 7 Avril 2017

Re,

Lone-wolf à dit:
Re Bruno
Les Slides ce sont les diapos? Sinon pour la 2ème solution, comment on fait?
EDIT: bonjour Michel

Oui les Slide ce sont les diapos, pour lier rien de plus simple
Dans Excel, tu copie ta plage (CTRL+C)

Dans ton Powerpoint -> Menu Accueil -> Collage Spécial

Dans la fenêtre, choisir -> Coller le lien et Objet feuille de calcul

Ensuite tu obtiens ta plage

Voili, voilou

Lone-wolf · 7 Avril 2017

Re Bruno

Merci. Mais comme l'a dit Michel, ce n'est pas terrible avec cette solution. Et en refaisant un test après avoir rajouté les diapos, rien ne s'affiche sur PowerPoint. Ais-je loupé quelque chose?

Compte Supprimé 979 · 7 Avril 2017

michel90 à dit:
Moi si j'ai utilisé cette solution car j'ai des cellules qui contiennent de gros commentaires! parfois des paragraphes. donc avec le collage avec liaison c'est très moche et le texte ne s'affiche pas au complet.

Faut Michel, si tu fais un ajustement de la hauteur de la ligne, il n'y a pas de problème !

Je fais des CODIR régulièrement avec des tableaux qui contiennent plus au moins de commentaire, si la cellule est à la bonne hauteur, ta diapo le sera

Compte Supprimé 979 · 7 Avril 2017

Re,

Lone-wolf à dit:
Re Bruno
Merci. Mais comme l'a dit Michel, ce n'est pas terrible avec cette solution. Et en refaisant un test après avoir rajouté les diapos, rien ne s'affiche sur PowerPoint. Ais-je loupé quelque chose?

Est-ce que ton Powerpoint est bien ouvert par le code !?

Lone-wolf · 7 Avril 2017

Re

Mais avec la macro, j'aimerais ajouter un article avec son image correspondante. Serait-il possible d'adapter la macro? Merci infiniment bruno

EDIT: Oui PowerPoint s'ouvre, mais rien n'est inscrit.

Lone-wolf · 7 Avril 2017

Re

Voici les deux fichiers, j'ai essaié d'adapter la macro, mais ce n'est pas encore ça. Pour chaque diapo, il faudrait obtenir ceci.
Article

Bain Moussant

Prix 59.-

Sous-titre Image

Compte Supprimé 979 · 7 Avril 2017

Lone-wolf à dit:
Re
Mais avec la macro, j'aimerais ajouter un article avec son image correspondante. Serait-il possible d'adapter la macro? Merci infiniment bruno
EDIT: Oui PowerPoint s'ouvre, mais rien n'est inscrit.

Attention !
Il faut que les cellules déterminée dans le code contiennent des valeurs ;-)

Lone-wolf · 7 Avril 2017

Re

On c'est croisés, regarde mon dernier message.

VBA erreur de compilation procédure trop grande

michel90

XLDnaute Nouveau

Compte Supprimé 979

Guest

Lone-wolf

XLDnaute Barbatruc

michel90

XLDnaute Nouveau

Compte Supprimé 979

Guest

michel90

XLDnaute Nouveau

Lone-wolf

XLDnaute Barbatruc

Compte Supprimé 979

Guest

Lone-wolf

XLDnaute Barbatruc

Compte Supprimé 979

Guest

Compte Supprimé 979

Guest

Lone-wolf

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Pièces jointes

Compte Supprimé 979

Guest

Lone-wolf

XLDnaute Barbatruc

Discussions similaires