VBA erreur de compilation procédure trop grande

M

michel90

XLDnaute Nouveau
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.
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re Michel

J'ai modifié le fichier pour avoir seulement le nom de l'article et son prix, si tu regarde la PJ de mon précédent message.

Maintenant j'ai modifié la macro comme ceci

VB: 
  On Error Resume Next
  NumSld = 0
  i = 0
With PresPpt
    '--- Ajoute un Slide
   ' .Slides.Add Index:=1, Layout:=ppLayoutBlank
        Do While NumSld < 40
     i = i + 1
     NumSld = NumSld + 1

      ' 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)
     Shp.TextFrame.TextRange.Text = Range("A" & 1 + NumSld) & vbLf & vbLf & "Prix " & Range("B" & 1 + NumSld) & ".-"
      'Modifie la couleur du texte
     Shp.TextFrame.TextRange.Font.Color = RGB(3, 34, 76)
      ' Définir le tableau des Slide
  
     TabCel = Split(Range("A" & 1 + NumSld), Range("B" & 1 + NumSld), ",")
      '
     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
     Loop
  End With

Mais les textes s'affichent dans le sous-titre. En image le résultat qu'il faudrait obtenir

image.gif
 
Dernière édition:
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Bonjour michel :), Bruno :)

@ michel: Merci pour le classeur demo. ;)

En attendant une réponse, j'ai fait autrement. J'ai supprimé les lignes qui étaient à double et mis une boucle pour les images. En PJ
 

Pièces jointes

  • Export-PowerPoint.zip
    523.8 KB · Affichages: 33
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
874
Dudy
D
cathodique
  • Question
XL 2010 Code de l'IA à corriger
2 3
Réponses
33
Affichages
1 K
cathodique
cathodique
Chaton77
  • Résolu(e)
Microsoft 365 En VBA : Extraire le mois d'une date d'un tableau
Réponses
7
Affichages
259
Chaton77
Chaton77
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
418
GClaire
G
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
411
florian50470
F
B
  • Question
Microsoft 365 Erreur de compilation
Réponses
3
Affichages
713
oguruma
oguruma
L
  • Résolu(e)
Microsoft 365 Changer code pour sélectionner 3lignes avec un pas de 1
Réponses
4
Affichages
418
laplayast
L
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
308
souhaib ad
S
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
606
crocrocro
C
S
  • Question
XL 2021 macro VBA excel
Réponses
1
Affichages
384
crocrocro
C

Membres actuellement en ligne

9 membres et 67 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 611
Messages
2 111 145
Membres
111 051
dernier inscrit
MANUREVALAND