Erreur de compilation lors de la suppression de contrôles

Résolu
Ein85 Messages postés 32 Statut Membre -  
Ein85 Messages postés 32 Statut Membre -
Bonjour à tous,

J'ai créé un programme qui permet d'ajouter dynamiquement un label dans lequel se trouve une textbox et un bouton "Delete". Il y a aussi un bouton "Add" qui permet de dupliquer ce trio label-textbox-bouton à volonté pour l'utilisateur. Bien évidemment, le bouton "Delete" permet de supprimer le label auquel il est associé ainsi que la textbox et lui même.
En parallèle j'ai aussi créé un bouton "Reset" qui supprime tous les trios créés par l'utilisateur. Le hic c'est que celui-ci ne fonctionne plus dès qu'il y a trois lots et Excel renvoie l'erreur de compilation suivante: "Seuls des commentaires peuvent apparaitre après End Sub, End Fonction, ou End Property". Le problème c'est que tout semble ok et d'ailleurs si je re-clique sur "Reset", le 3ème lot restant est supprimé sans problème.

Quelqu'un pourrait-il m'aider svp?

Je vous aurais bien mis en PJ mon fichier mais je n'ai pas l'impression que c'est faisable.

Il faut créer dans la première feuille un bouton "Validate", un bouton "Reset", une textbox nommée "FrmCounter" (valeur d'origine = 1), une autre "FrmIndex (valeur =1) et une troisième "LeftCounter".

Voici le code (désolé, il est un peu lourd malgré mes simplifications):

'Dans Feuil1:

Option Explicit

Private Sub Validate_Click()

Call FrmCreation
Call AddButtonFrm


End Sub

Sub Reset_Click()

Dim Ctrl As OLEObject
Dim MyVar, MySheet, DeleteAddMacro As String


'Macro pour enlever tous les contrôles ajoutés dynamiquement

MySheet = ActiveSheet.Name


For Each Ctrl In ActiveSheet.OLEObjects 'Loop sur chaque contrôle

If TypeOf Ctrl.Object Is MSForms.CommandButton Then

If Ctrl.Object.Caption = "Delete" Then 'Si c'est un bouton Delete, on appelle sa sub qui se charge de la suppression
MyVar = Ctrl.Name
Application.Run (MySheet & "." & MyVar & "_Click")

ElseIf Ctrl.Object.Caption = "Add" Then 'Si c'est un bouton Add, on le supprime directement ainsi que son code
MyVar = Ctrl.Name & "_Click"
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.DeleteLines .ProcStartLine(MyVar, 0), .ProcCountLines(MyVar, 0) 'Suppression du code du bouton Add
End With
ActiveSheet.Shapes(Ctrl.Name).Delete
End If

End If

Next Ctrl

End Sub

'Code du Module1

Option Explicit

Public Sub AddButtonFrm()

'Crée le bouton "Add"

Dim Obj As OLEObject
Dim MacroAdd As String
Dim X As Integer

'Ajoute le bouton dans la feuille
Set Obj = Worksheets(1).OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=67, Top:=400, Width:=50, Height:=30)
With Obj
.Name = "FrmAdd"
.Object.Caption = "Add"
End With

'Ajoute le code associé au bouton:
MacroAdd = "Sub FrmAdd_Click()" & vbCrLf
MacroAdd = MacroAdd & "Call FrmCreation" & vbCrLf
MacroAdd = MacroAdd & "End Sub" & vbCrLf

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
X = .CountOfLines + 1
.InsertLines X, MacroAdd
End With
End Sub

Sub FrmCreation()

Dim Lab, Del, TxtBody As Object
Dim DeleteMacro As String
Dim X, LabelCounter, LabelIndex As Integer

'Macro généréé lorsqu'on clique sur le bouton "Add"

LabelCounter = ActiveSheet.FrmCounter.Value 'Compteur utilisé pour connaître le nombre de labels créés
LabelIndex = ActiveSheet.FrmIndex.Value 'Compteur utilisé pour donner un nom au nouveaux objets créés (labels et objets à l'intérieur)

'-----------------------------------------------
'Crée FRM LABEL:
Set Lab = Worksheets(1).OLEObjects.Add(ClassType:="Forms.Label.1", Left:=(LabelCounter - 1) * 300 + 47 + 10 * LabelCounter, Top:=250, Width:=300, Height:=130) 'Crée un Label

With Lab
.Name = "Frm" & LabelIndex & ""

With .Object
.Caption = " Frm " & LabelIndex & ""
.BackStyle = 0
.BorderStyle = 1
End With
End With

'-----------------------------------------------
'Crée TEXTBOX:
Set TxtBody = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Left:=(LabelCounter - 1) * 300 + 57 + 10 * LabelCounter, Top:=265, Width:=240, Height:=60)

With TxtBody
.Name = "Frm" & LabelIndex & "TxtBody"
End With


'-----------------------------------------------
'Crée bouton "DELETE":
Set Del = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=(LabelCounter - 1) * 300 + 57 + 10 * LabelCounter, Top:=340, Width:=50, Height:=30)


With Del
.Name = "Frm" & LabelIndex & "Delete"
With .Object
.Caption = "Delete"
End With
End With

'Insert le code du bouton Delete (cliqué sur celui-ci supprimera le label et les contrôles à l'intérieur
DeleteMacro = "Sub Frm" & LabelIndex & "Delete_Click()" & vbCrLf
DeleteMacro = DeleteMacro & "ActiveSheet.LeftCounter.Value =ActiveSheet.Frm" & LabelIndex & ".Left" & vbCrLf
DeleteMacro = DeleteMacro & "ActiveSheet.Shapes(""Frm" & LabelIndex & "TxtBody"").Delete" & vbCrLf
DeleteMacro = DeleteMacro & "ActiveSheet.Shapes(""Frm" & LabelIndex & "Delete"").Delete" & vbCrLf
DeleteMacro = DeleteMacro & "ActiveSheet.Shapes(""Frm" & LabelIndex & """).Delete" & vbCrLf
DeleteMacro = DeleteMacro & "With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule" & vbCrLf
DeleteMacro = DeleteMacro & " .DeleteLines .ProcStartLine(""Frm" & LabelIndex & "Delete_Click"", 0), .ProcCountLines(""Frm" & LabelIndex & "Delete_Click"", 0)" & vbCrLf 'Supprime le code du bouton Delete
DeleteMacro = DeleteMacro & "End With" & vbCrLf
DeleteMacro = DeleteMacro & "Call ShiftControls" & vbCrLf
DeleteMacro = DeleteMacro & "ActiveSheet.FrmCounter.Value = ActiveSheet.FrmCounter.Value - 1" & vbCrLf
DeleteMacro = DeleteMacro & "End Sub" & vbCrLf

With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
X = 0 'Reset X sur 0
X = .CountOfLines + 1
.InsertLines X, DeleteMacro
End With

ActiveSheet.FrmCounter.Value = LabelCounter + 1
ActiveSheet.FrmIndex.Value = LabelIndex + 1

End Sub

'Code du Module2

Option Explicit

Sub ShiftControls()

Dim Ctrl As OLEObject

'Macro servant à déplacer les labels et leurs contrôles si un label situé à gauche est supprimé

'Loop sur chaque contrôle
For Each Ctrl In ActiveSheet.OLEObjects

'Se focalise sur les contrôles dont la propriété Top est comprise entre 200 et 380
If Ctrl.Top >= 200 And Ctrl.Top <= 380 And Ctrl.Left > ActiveSheet.LeftCounter.Value Then

'Déplace le contrôle de 310 vers la gauche
Ctrl.Left = Ctrl.Left - 310

End If
Next Ctrl

End Sub

4 réponses

Réponse 1 / 4
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
C'est exact, c'est assez aléatoire; J'attendais ta réponse. J'ai trouvé une solution radicale:
Supprimer le code de toute la feuille car c'est la suppression des codes qui bloque. Dans la foulée réinjecter le code des 2 boutons avec mise à zero des compteurs comme ceci:
inserer un module avec ce code: 

Option Explicit
Sub EffaceShapesSaufBoutons()
Dim Obj As OLEObject
Dim MacroAdd As String
Dim X As Integer
Dim i
For Each i In ActiveSheet.Shapes
      If i.Name = "Validate" Or i.Name = "FrmCounter" Or i.Name = "FrmIndex" Or i.Name = "LeftCounter" Or i.Name = "Reset" Then
      'on ne supprime pas ces shapes
      Else
      'supprime tout le code de la feuille active
     With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Sheets(ActiveSheet.Name).CodeName).CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
ActiveSheet.Shapes(i.Name).Delete 'supprime les shapes
      End If
    Next i
    
    'dans la feuille active
     'Ajoute le code associé au bouton:validate
    MacroAdd = "Private Sub Validate_Click()" & vbCrLf
    MacroAdd = MacroAdd & "FrmCounter = 1" & vbCrLf
    MacroAdd = MacroAdd & "FrmIndex = 1" & vbCrLf
    MacroAdd = MacroAdd & "Call AddButtonFrm" & vbCrLf
    MacroAdd = MacroAdd & "Call FrmCreation" & vbCrLf
    MacroAdd = MacroAdd & "Validate.Enabled = False" & vbCrLf
    MacroAdd = MacroAdd & "Reset.Enabled = True " & vbCrLf
    MacroAdd = MacroAdd & "End Sub" & vbCrLf
     With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        X = .CountOfLines + 1
        .InsertLines X, MacroAdd
    End With
    
    'Ajoute le code associé au bouton:reset
    MacroAdd = "Private Sub Reset_Click()" & vbCrLf
    MacroAdd = MacroAdd & "EffaceShapesSaufBoutons" & vbCrLf
    MacroAdd = MacroAdd & "Validate.Enabled = True" & vbCrLf
    MacroAdd = MacroAdd & "Reset.Enabled = False" & vbCrLf
    MacroAdd = MacroAdd & "End Sub" & vbCrLf
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        X = .CountOfLines + 1
        .InsertLines X, MacroAdd
    End With
 End Sub


et dans la feuille active ceci: 

Private Sub Validate_Click()
FrmCounter = 1
FrmIndex = 1
Call AddButtonFrm
Call FrmCreation
Validate.Enabled = False
Reset.Enabled = True
End Sub

Private Sub Reset_Click()
EffaceShapesSaufBoutons
Validate.Enabled = True
Reset.Enabled = False
End Sub


Normalement j'ai testé, il n'y a pas de problème!

1
Ein85 Messages postés 32 Statut Membre
 
Désolé pour cette réponse tardive mais merci beaucoup pour ton aide, ça m'a été et me sera très utile.
0
Réponse 2 / 4
f894009 Messages postés 17413 Statut Membre 1 715
 
Bonjour,

mais je n'ai pas l'impression que c'est faisable. Ah que si!!!!

Pour transmettre un fichier,
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
0
Ein85 Messages postés 32 Statut Membre
 
Bonjour,
Je ne connaissais pas cette astuce. J'ai fait comme indiqué et l'on peut désormais trouver le fichier Excel à cette adresse: http://www.cjoint.com/c/ELrlRYVrkdm
Pour comprendre le problème, on peut procéder de la manière suivante:
- Cliquer sur Validate pour faire apparaître un label puis cliquer sur le bouton Add pour en faire apparaître un 2ème.
- Cliquer ensuite sur Reset pour supprimer le tout => Dans ce cas ça fonctionne
- Recommencer mais en créant cette fois-ci 3 labels => Dans ce cas on obtient l'erreur mentionnée.
Merci d'avance
0
Réponse 3 / 4
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
Bonjour,

Une solution pour ne pas avoir de bug, il faut supprimer à chaque action sur le bouton un trio à la fois et le bouton Add à la fin comme ceci : 

Option Explicit
 Private Sub Validate_Click()
Call AddButtonFrm
Call FrmCreation
Validate.Enabled = False
End Sub

Sub Reset_Click()
Dim Ctrl As OLEObject
Dim MyVar, MySheet As String
'Macro pour enlever tous les contrôles ajoutés dynamiquement
MySheet = ActiveSheet.Name
For Each Ctrl In ActiveSheet.OLEObjects 'Loop sur chaque contrôle
  
    If TypeOf Ctrl.Object Is MSForms.CommandButton Then

      If Ctrl.Object.Caption = "Delete" Then 'Si c'est un bouton Delete, on appelle sa sub qui se charge de la suppression
        MyVar = Ctrl.Name
        Application.Run (MySheet & "." & MyVar & "_Click")
          Exit Sub
      End If
      End If
Next Ctrl
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
      .DeleteLines .ProcStartLine("FrmAdd_Click", 0), .ProcCountLines("FrmAdd_Click", 0) 'Suppression du code du bouton Add
      End With
      ActiveSheet.Shapes("FrmAdd").Delete
      Validate.Enabled = True
End Sub


j'ai mis 
Validate.Enabled = False
pour ne pas avoir 2 boutons Add qui occasionneraient un bug aussi!
0
Ein85 Messages postés 32 Statut Membre
 
Bonjour,
Merci pour ta réponse mais le but du bouton Reset est de tout supprimer d'un coup. Si l'utilisateur souhaite simplement supprimer les lots individuellement, il clique sur Delete. Dans le cas que tu proposes, il n'y a plus vraiment de différence entre Reset et Delete si ce n'est qu'avec Delete tu choisis précisément le lot à supprimer, ce qui n'est pas le cas de Reset. Est-il possible d'arriver au résultat voulu, à savoir la suppression générale?
Merci d'avance!
0
Réponse 4 / 4
cs_Le Pivert Messages postés 8437 Statut Contributeur 729
 
J'ai réussi, mais ce n'est pas évident. J'ai fait une Sub de réinitialisation. Ensuite je l'ai appelé avec une boucle, comme ceci: 

Option Explicit
Private Sub Validate_Click()
Call AddButtonFrm
Call FrmCreation
Validate.Enabled = False 'inactif
Reset.Enabled = True 'actif
End Sub
Sub Reset_Click()
Dim nombre, i As Integer
nombre = ActiveSheet.Shapes.Count 'nombre de shapes
nombre = nombre - 6 'on enleve les shapes qui doivent rester
On Error Resume Next 'pour éviter le bug
For i = nombre To 1 Step -3 'on demarre à l'envers toutes les 3 shapes, il y a 3 shapes par trio
Reinitialise 'on lance le reset
Next i
End Sub
Sub Reinitialise()
Dim Ctrl As OLEObject
Dim MyVar, MySheet As String
'Macro pour enlever tous les contrôles ajoutés dynamiquement
MySheet = ActiveSheet.Name

For Each Ctrl In ActiveSheet.OLEObjects 'Loop sur chaque contrôle
  
    If TypeOf Ctrl.Object Is MSForms.CommandButton Then

      If Ctrl.Object.Caption = "Delete" Then 'Si c'est un bouton Delete, on appelle sa sub qui se charge de la suppression
        MyVar = Ctrl.Name
        Application.Run (MySheet & "." & MyVar & "_Click")
     End If
      End If
Next Ctrl
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
     .DeleteLines .ProcStartLine("FrmAdd_Click", 0), .ProcCountLines("FrmAdd_Click", 0) 'Suppression du code du bouton Add
      End With
      ActiveSheet.Shapes("FrmAdd").Delete
     Validate.Enabled = True 'actif
Reset.Enabled = False 'inactif
End Sub


C'est la seule façon pour éviter un bug!
0
Ein85 Messages postés 32 Statut Membre
 
La solution semble prometteuse mais c'est sans compter sur Excel qui veut n'en faire qu'à sa tête.

J'ai testé ton code et j'ai des résultats qui varient selon que je cherche à supprimer un lot, deux lots ou trois lots.

Si je n'en supprime qu'un, ça marche très bien.
Si j'en supprime deux, j'ai une erreur de compilation pour la suppression du 2ème lot (End Sub attendu alors qu'il est bien là).
Et enfin, si je veux en supprimer trois, là Excel plante carrément. As-tu rencontré ces problèmes de ton côté?
0

Discussions similaires

Table des matières dont les titres n'apparaissent pas..
Synua -
ggg -

10 réponses
Erreur de lecture sur iptv smarters
Bogs -
bazfile -

1 réponse
Erreur 3005 sur France TV
Cambodgil -
PK -

5 réponses
Erreur de lecture des tv film et series sur mon appli iptv smarters pro
Constantenzostanley -
glandu -

1 réponse
Market Place "Erreur lors de l'envoi de la requête"
JobnatureAloevera -
Radinoz -

5 réponses