VBA erreur de compilation procédure trop grande

Le 05/04/2017 à 11:01

Bonjour,

j'ai un léger problème dans ma macro, et je j'amerais que quelqu'un puisse m'aidert SVP.

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

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.

      '-------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.

Le 05/04/2017 à 11:19

Bonjour,

Si on te dit qu'elle est trop grande, faut la réduire !! Tu supprimes TOUTES les répétitions au profit de boucles... Normalement elle va fondre !!!

Par la même occasion, si tu l'indentes, correctement autant que possible, je finirai par la lire, mais en l'état, ce serait un calvaire !

Le 05/04/2017 à 11:26

Bonjour,

Outre la remarque de Ferrand...

Dans ce genre de situation, je pense que ce n'est pas tant la procédure qui est cause, (En fait c'est un message général) que la somme totale des procédures de tous les modules du classeur qui pourrait être en cause.

A+

Le 05/04/2017 à 11:33

Bonjour,

si je te dis que j'ai essayé de le réduire avec cette macro que j'appale ensuite dans la macro principal. mais j'ai cette erreur

erreur 91 :

varaible objet ou variable de bloc with non définie

Sub inserEtat()
Dim sld As PowerPoint.Slide
Dim Shp As PowerPoint.Shape
Dim presppt As PowerPoint.Presentation
With presppt

     '-------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)
'-------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)
      '-------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)

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

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

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

        '-------Etat metz
 Set Shp = .Slides(8).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)
      If Range("D9") <> 0 Then Shp.TextFrame.TextRange.Text = Range("D9")
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
End With
End Sub
Le 05/04/2017 à 18:18

On va pas t'aider beaucoup sur ce coup... Il faut que tu débogues toi-même.

Tu acceptes le débogage et tu regarde ce qui est en surbrillance.

Quelquefois une ligne est en surbrillance ET un mot est sélectionné.

Quelquefois tu n'as rien en surbrillance et il faut détecter la ligne fautive... avec F8, F8, F8...

Là comme tu dis que c'est une macro que tu appelles avec la procédure principale, j'ai l'impression qu'il te manque "une passerelle" entre les deux... Une variable qui n'est pas déclarée publique peut-être ?

Dim presppt As PowerPoint.Presentation
With presppt

???

Si c'est en relation avec celle que tu as ouvert dans la Sub Import il me semble qu'il y a un chainon manquant ?

Mébon je dis ça... j'ai rien dit ! C'est vraiment avec ma boule de cristal...

A+

Le 06/04/2017 à 09:42

bonjour,

l'erreur se positionne ici :

Set Shp = .Slides(2).Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 100, 350, 40)

mais je pense que ça relève d'une variable c'est sûr. Mais comment faire, quecqu'il faut rajouter. j'en sais rien

Rechercher des sujets similaires à "vba erreur compilation procedure trop grande"