Discussion :

[barjovial]

Bonjour à tous,

Dans le cadre d'une application Excel, j'aurais besoin de créer (par le code) plusieurs boutons et d'associer (toujours par le code) une macro (la macro XXX_click() en l'occurence) à chacun de ces boutons.

La création d'un seul bouton+macro fonctionne correctement par contre dès que j'essaie d'en créer plusieurs (dans une boucle) j'ai l'erreur suivante :

Erreur d'exécution '-2147417848 (800010108)':
Erreur Automation
L'objet invoqué s'est déconnecté de ses clients

Voici le code que je test :

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
 
Private Sub createClientLine()
    Dim index As Integer
    Dim startTop As Double
    Dim macroCode As String
    Dim nextLine As String
    Dim colObj As Collection
 
    Set colObj = New Collection
 
    startTop = 507.5
 
    For index = 1 To 5
        startTop = startTop + 40
        colObj.add (ActiveWorkbook.ActiveSheet.OLEObjects.add(ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, Left:=300, Top:=startTop, Width:=72, Height:=18))
        colObj.Item(index).name = "tbx_" & index
 
        macroCode = "Private Sub tbx_" & index & "_Click()" & vbCrLf
        macroCode = macroCode & "MsgBox 21" & vbCrLf
        macroCode = macroCode & "End sub" & vbCrLf
 
        With ActiveWorkbook.VBProject.VBComponents("Feuil2").CodeModule
            nextLine = .CountOfLines + 2
            .insertlines nextLine, macroCode
        End With
 
    Next
End Sub

La création des boutons seuls fonctionne correctement. C'est lors de la création de la macro du second bouton que l'erreur survient.

Pour info j'utilise Excel 2000 sur un windows XP.

Merci d'avance

[fring]

Bonjour,

Teste ceci

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
Sub creation_bouton()
Dim i As Byte, T As Single, Cbut As OLEObject, col As New Collection
Application.ScreenUpdating = False
 
T = 500
 
For i = 1 To 5
    Set Cbut = Sheets("Feuil2").OLEObjects.Add(ClassType:="Forms.CommandButton.1")
    With Cbut
        .Top = T
        .Left = 300
        .Width = 70
        .Height = 22
        .Name = "tbx_" & i
        .Object.Caption = "Bouton " & i
    End With
 
    col.Add "Private Sub tbx_" & i & "_Click()"
    col.Add "MsgBox " & """Bouton de commande " & i & ""
    col.Add "End sub"
 
    T = T + 40
    Set Cbut = Nothing
Next
 
With ActiveWorkbook.VBProject.VBComponents("Feuil2").CodeModule
    For i = 1 To col.Count
        nextLine = .CountOfLines + 2
        .insertlines nextLine, col.Item(i)
    Next
End With
 
Application.ScreenUpdating = True
End Sub

[barjovial]

Bonjour,

Merci beaucoup Fring ça fonctionne. J'ai juste apporté une petite modif à ton code. Une erreur survenait sur la ligne suivante :

Code :

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

1
2
 
Set Cbut = Sheets("Feuil2").OLEObjects.Add(ClassType:="Forms.CommandButton.1")

Donc le code final est le suivant :

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
 
Sub creation_bouton()
Dim i As Byte, T As Single, Cbut As OLEObject, col As New Collection
Dim nextLine As String
Application.ScreenUpdating = False
 
T = 500
 
For i = 1 To 5
    Set Cbut = (ActiveWorkbook.ActiveSheet.OLEObjects.add(ClassType:="Forms.CommandButton.1", _
            Link:=False, DisplayAsIcon:=False, Left:=300, Top:=T, Width:=70, Height:=22))
 
    With Cbut
        .name = "tbx_" & i
        .Object.Caption = "Bouton " & i
    End With
 
    col.add "Private Sub tbx_" & i & "_Click()"
    col.add "MsgBox " & """Bouton de commande " & i & ""
    col.add "End sub"
 
    T = T + 40
    Set Cbut = Nothing
Next
 
With ActiveWorkbook.VBProject.VBComponents("Feuil2").CodeModule
    For i = 1 To col.Count
        nextLine = .CountOfLines + 2
        .insertlines nextLine, col.Item(i)
    Next
End With
 
Application.ScreenUpdating = True
End Sub

Bonne journée à tous et encore une fois merci.