Problème pour créer le code des ToggleButton par vba

Bonjour à tous,

Tout d'abord, merci à tous ceux qui contribuent à ce NG car c'est grâce à
eux que j'ai pu avancer dans mon problème.
Par contre, je suis bloqué et ne trouve pas les infos dont j'ai besoin (
sauf erreur de ma part )

Voici l'idée :
Je travail sous Excel 2003.
Je souhaite par macro pouvoir créer des TogglesButtons et ajouter le code
_click par macro dans la feuille concernée.
Au stade ou j'en suis, j'arrive à créer les boutons, mais Excel plante
complètement dès qu'il s'agit de créer le code dans la feuille.

Voici ce que j'ai fait :

J'ai créé les 2 fonctions suivantes qui fonctionne très bien utilisées
séparéments

*************************************************************************
Function CreerLeToggle(cellule As String)

ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1",
Link:úlse, _
DisplayAsIcon:úlse, Left:=0, Top:=0, Width:€, Height:) _
.Select

With Selection
.Name = "Toggle" & cellule
.Top = Range(cellule).Top
.Left = Range(cellule).Left
.Width = Range(cellule).Width
.Height = Range(cellule).Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

End Function

Function AjoutCode(CodeAAjouter As String, IndexFeuille As Integer)

Dim comp As Object, NoLigne As Integer


Set comp = ThisWorkbook.VBProject.VBComponents("Feuil" &
IndexFeuille).CodeModule

comp.AddFromString CodeAAjouter

Set comp = Nothing

End Function

*****************************************************************************

Ensuite, j'ai créé la macro suivante. Enfin là, je l'ai simplifiée au
minimum pour ne montrer que ce qui cloche :

**********************************************************************

Sub CreerToggleButton()

Dim Lig As Integer
Dim NbToggle As Integer
Dim CodeToggle As String
Dim i As Integer
Dim Nom As String
NbToggle = 0



Columns("H:I").ColumnWidth = 5
Rows("7:20").RowHeight = 16.5
ActiveSheet.OLEObjects.Delete

For Lig = 7 To 20

CreerLeToggle ("H" & Lig)
CreerLeToggle ("I" & Lig)
NbToggle = NbToggle + 2

Next Lig

For i = 1 To NbToggle

Nom = ActiveSheet.OLEObjects.Item(i).Name
Lig = CInt(Right(Nom, Len(Nom) - 7))

If Mid(Nom, 7, 1) = "H" Then
CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf
& vbCrLf _
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig & "
= False" & vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If
If Mid(Nom, 7, 1) = "I" Then
ActiveSheet.OLEObjects(Nom).Object = True
CodeToggle = "Private Sub ToggleI" & Lig & "_Click()" & vbCrLf
& vbCrLf _
& " If ToggleI" & Lig & " = False Then" & vbCrLf _
& " If ToggleH" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleH" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleH" & Lig & " = True Then ToggleH" & Lig & "
= False" & vbCrLf _
& " Range(""I" & Lig & """) = 0" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If

Next i


MsgBox "Fin"

End Sub

********************************************************************

Et c'est cette macro qui cloche. La création des toggle marche
parfaitement, mais dès la première exécution de la fonction AjoutCode,
j'ai le beau message "Excel a rencontré une erreur... blablabla..." et il
se ferme.
Je n'ai même pas de message de déboguage.

Par contre, si manuellement, je lance la macro suivante, ça marche sans
problème alors que c'est le même code que j'essai d'ajouter.
***************************************************************
Sub CopierCode()

Dim CodeToggle As String
Dim Lig As Integer

Lig = 8

CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf & vbCrLf
_
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" & vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig & " =
False" & vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End Sub
***************************************************************

J'ai exclu la possibilité que ce soit une trop grande quantité de code
puisque, déjà c'est pas le cas, et qu'en plus, la macro plante à la
première insertion de code...
J'ai essayé ma macro depuis un autre PC avec Excel 2003, même punition...
:o(

Je vous en prie, dites moi que quelqu'un sait quel connerie j'ai bien pu
faire dans ce foutu code ....
A moins que vous ayez un autre méthode que me permette par macro d'insérer
du code dans le module d'une feuille...

Merci d'avance pour votre aide.

A+

Bon, ben en fait je me réponds tout seul... ;o)

Il semblerait que mon problème vienne du fait que je passe l'index de la
feuille directement en paramètre
--> AjoutCode(CodeToggle, ActiveSheet.Index)
Apparemment, ça ne lui plait pas.

Si je passe par une variable integer, il n'y a plus de soucis...

Dim Idx as integer
Idx = Activesheet.Index
AjoutCode(CodeToggle,Idx)

Perso, je ne comprends pas pourquoi.
Même si dans la déclaration de la fonction je rajout byval pour mon index,
ça plante quand même.

Pour l'instant, j'ai trouvé la solution, mais si quelqu'un sait pourquoi
ça merdre, ma curiosité vous en remercierait grandement... ;o)

En tout cas, merci à ceux qui auront quand même essayé de se pencher sur
mon problème.

A+


"Fabrice N." <"f.nebbia" dans le domaine "technicn.com"> a écrit dans le
message de news: u5uGM3kNHHA.3872@TK2MSFTNGP06.phx.gbl...

Bonjour à tous,

Tout d'abord, merci à tous ceux qui contribuent à ce NG car c'est grâce à
eux que j'ai pu avancer dans mon problème.
Par contre, je suis bloqué et ne trouve pas les infos dont j'ai besoin
( sauf erreur de ma part )

Voici l'idée :
Je travail sous Excel 2003.
Je souhaite par macro pouvoir créer des TogglesButtons et ajouter le code
_click par macro dans la feuille concernée.
Au stade ou j'en suis, j'arrive à créer les boutons, mais Excel plante
complètement dès qu'il s'agit de créer le code dans la feuille.

Voici ce que j'ai fait :

J'ai créé les 2 fonctions suivantes qui fonctionne très bien utilisées
séparéments

*************************************************************************
Function CreerLeToggle(cellule As String)

ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1",
Link:úlse, _
DisplayAsIcon:úlse, Left:=0, Top:=0, Width:€, Height:) _
.Select

With Selection
.Name = "Toggle" & cellule
.Top = Range(cellule).Top
.Left = Range(cellule).Left
.Width = Range(cellule).Width
.Height = Range(cellule).Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

End Function

Function AjoutCode(CodeAAjouter As String, IndexFeuille As Integer)

Dim comp As Object, NoLigne As Integer


Set comp = ThisWorkbook.VBProject.VBComponents("Feuil" &
IndexFeuille).CodeModule

comp.AddFromString CodeAAjouter

Set comp = Nothing

End Function

*****************************************************************************

Ensuite, j'ai créé la macro suivante. Enfin là, je l'ai simplifiée au
minimum pour ne montrer que ce qui cloche :

**********************************************************************

Sub CreerToggleButton()

Dim Lig As Integer
Dim NbToggle As Integer
Dim CodeToggle As String
Dim i As Integer
Dim Nom As String
NbToggle = 0



Columns("H:I").ColumnWidth = 5
Rows("7:20").RowHeight = 16.5
ActiveSheet.OLEObjects.Delete

For Lig = 7 To 20

CreerLeToggle ("H" & Lig)
CreerLeToggle ("I" & Lig)
NbToggle = NbToggle + 2

Next Lig

For i = 1 To NbToggle

Nom = ActiveSheet.OLEObjects.Item(i).Name
Lig = CInt(Right(Nom, Len(Nom) - 7))

If Mid(Nom, 7, 1) = "H" Then
CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf
& vbCrLf _
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig &
" = False" & vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If
If Mid(Nom, 7, 1) = "I" Then
ActiveSheet.OLEObjects(Nom).Object = True
CodeToggle = "Private Sub ToggleI" & Lig & "_Click()" & vbCrLf
& vbCrLf _
& " If ToggleI" & Lig & " = False Then" & vbCrLf _
& " If ToggleH" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleH" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleH" & Lig & " = True Then ToggleH" & Lig &
" = False" & vbCrLf _
& " Range(""I" & Lig & """) = 0" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If

Next i


MsgBox "Fin"

End Sub

********************************************************************

Et c'est cette macro qui cloche. La création des toggle marche
parfaitement, mais dès la première exécution de la fonction AjoutCode,
j'ai le beau message "Excel a rencontré une erreur... blablabla..." et il
se ferme.
Je n'ai même pas de message de déboguage.

Par contre, si manuellement, je lance la macro suivante, ça marche sans
problème alors que c'est le même code que j'essai d'ajouter.
***************************************************************
Sub CopierCode()

Dim CodeToggle As String
Dim Lig As Integer

Lig = 8

CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf &
vbCrLf _
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" & vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig & " =
False" & vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End Sub
***************************************************************

J'ai exclu la possibilité que ce soit une trop grande quantité de code
puisque, déjà c'est pas le cas, et qu'en plus, la macro plante à la
première insertion de code...
J'ai essayé ma macro depuis un autre PC avec Excel 2003, même punition...
:o(

Je vous en prie, dites moi que quelqu'un sait quel connerie j'ai bien pu
faire dans ce foutu code ....
A moins que vous ayez un autre méthode que me permette par macro
d'insérer du code dans le module d'une feuille...

Merci d'avance pour votre aide.

A+

A moins que vous ayez un autre méthode que me permette par macro
d'insérer

du code dans le module d'une feuille...

Bonjour à tous,

Tout d'abord, merci à tous ceux qui contribuent à ce NG car c'est grâce à
eux que j'ai pu avancer dans mon problème.
Par contre, je suis bloqué et ne trouve pas les infos dont j'ai besoin (
sauf erreur de ma part )

Voici l'idée :
Je travail sous Excel 2003.
Je souhaite par macro pouvoir créer des TogglesButtons et ajouter le code
_click par macro dans la feuille concernée.
Au stade ou j'en suis, j'arrive à créer les boutons, mais Excel plante
complètement dès qu'il s'agit de créer le code dans la feuille.

Voici ce que j'ai fait :

J'ai créé les 2 fonctions suivantes qui fonctionne très bien utilisées
séparéments

*************************************************************************
Function CreerLeToggle(cellule As String)

ActiveSheet.OLEObjects.Add(ClassType:="Forms.ToggleButton.1",
Link:úlse, _
DisplayAsIcon:úlse, Left:=0, Top:=0, Width:€, Height:) _
.Select

With Selection
.Name = "Toggle" & cellule
.Top = Range(cellule).Top
.Left = Range(cellule).Left
.Width = Range(cellule).Width
.Height = Range(cellule).Height
.Placement = xlMoveAndSize
.PrintObject = True
End With

End Function

Function AjoutCode(CodeAAjouter As String, IndexFeuille As Integer)

Dim comp As Object, NoLigne As Integer


Set comp = ThisWorkbook.VBProject.VBComponents("Feuil" &
IndexFeuille).CodeModule

comp.AddFromString CodeAAjouter

Set comp = Nothing

End Function

*****************************************************************************

Ensuite, j'ai créé la macro suivante. Enfin là, je l'ai simplifiée au
minimum pour ne montrer que ce qui cloche :

**********************************************************************

Sub CreerToggleButton()

Dim Lig As Integer
Dim NbToggle As Integer
Dim CodeToggle As String
Dim i As Integer
Dim Nom As String
NbToggle = 0



Columns("H:I").ColumnWidth = 5
Rows("7:20").RowHeight = 16.5
ActiveSheet.OLEObjects.Delete

For Lig = 7 To 20

CreerLeToggle ("H" & Lig)
CreerLeToggle ("I" & Lig)
NbToggle = NbToggle + 2

Next Lig

For i = 1 To NbToggle

Nom = ActiveSheet.OLEObjects.Item(i).Name
Lig = CInt(Right(Nom, Len(Nom) - 7))

If Mid(Nom, 7, 1) = "H" Then
CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf &
vbCrLf _
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig & "
= False" & vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If
If Mid(Nom, 7, 1) = "I" Then
ActiveSheet.OLEObjects(Nom).Object = True
CodeToggle = "Private Sub ToggleI" & Lig & "_Click()" & vbCrLf &
vbCrLf _
& " If ToggleI" & Lig & " = False Then" & vbCrLf _
& " If ToggleH" & Lig & " = True Then Exit Sub" &
vbCrLf _
& " ToggleH" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleH" & Lig & " = True Then ToggleH" & Lig & "
= False" & vbCrLf _
& " Range(""I" & Lig & """) = 0" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End If

Next i


MsgBox "Fin"

End Sub

********************************************************************

Et c'est cette macro qui cloche. La création des toggle marche parfaitement,
mais dès la première exécution de la fonction AjoutCode, j'ai le beau
message "Excel a rencontré une erreur... blablabla..." et il se ferme.
Je n'ai même pas de message de déboguage.

Par contre, si manuellement, je lance la macro suivante, ça marche sans
problème alors que c'est le même code que j'essai d'ajouter.
***************************************************************
Sub CopierCode()

Dim CodeToggle As String
Dim Lig As Integer

Lig = 8

CodeToggle = "Private Sub ToggleH" & Lig & "_Click()" & vbCrLf & vbCrLf
_
& " If ToggleH" & Lig & " = False Then" & vbCrLf _
& " If ToggleI" & Lig & " = True Then Exit Sub" & vbCrLf _
& " ToggleI" & Lig & " = True" & vbCrLf _
& " Exit Sub" & vbCrLf _
& " End If" & vbCrLf _
& " If ToggleI" & Lig & " = True Then ToggleI" & Lig & " = False"
& vbCrLf _
& " Range(""I" & Lig & """) = 1" & vbCrLf & vbCrLf _
& "End Sub" & vbCrLf
Call AjoutCode(CodeToggle, ActiveSheet.Index)

End Sub
***************************************************************

J'ai exclu la possibilité que ce soit une trop grande quantité de code
puisque, déjà c'est pas le cas, et qu'en plus, la macro plante à la première
insertion de code...
J'ai essayé ma macro depuis un autre PC avec Excel 2003, même punition...
:o(

Je vous en prie, dites moi que quelqu'un sait quel connerie j'ai bien pu
faire dans ce foutu code ....
A moins que vous ayez un autre méthode que me permette par macro d'insérer
du code dans le module d'une feuille...

Merci d'avance pour votre aide.

A+

* http://frederic.sigonneau.free.fr rubrique VBA
* Archives Google avec le mot-clé CodeModule
* m'étonnerais qu'il ny ait rien sur http://www.excelabo.net

Je souhaite par macro pouvoir créer des TogglesButtons et ajouter le code
_click par macro dans la feuille concernée.

Voici le code de ton fichier réorganisé.

Et ton code fonctionne : http://cjoint.com/?bpq5US66EI

P.S. à l'intérieur d'une même procédure, on ne peut pas exécuter
2 fois cette ligne de code en utilisant une boucle. Ton code a été
réorganisé en tenant compte de ce qui précède.

'--------------------------
With ThisWorkbook.VBProject.VBComponents(Worksheets(LaFeuille).CodeName).CodeModule
.AddFromString Code
End With
'--------------------------

Je laisse à FxM et à Modeste le soin de nous expliquer le pourquoi

Voici le code de ton fichier réorganisé.

Et ton code fonctionne : http://cjoint.com/?bpq5US66EI

P.S. à l'intérieur d'une même procédure, on ne peut pas exécuter
2 fois cette ligne de code en utilisant une boucle. Ton code a été
réorganisé en tenant compte de ce qui précède.

'--------------------------
With ThisWorkbook.VBProject.VBComponents(Worksheets(LaFeuille).CodeName).CodeModule
.AddFromString Code
End With
'--------------------------

Je laisse à FxM et à Modeste le soin de nous expliquer le pourquoi

| Pourquoi nous ? Mais euuuh ...

Comme vos réponses subornaient une confiance à ton crin,
je suppose que vous connaissez tous les tenants et aboutissants
de ce type de procédure ! ;-))

Voici le code de ton fichier réorganisé.

Et ton code fonctionne : http://cjoint.com/?bpq5US66EI

P.S. à l'intérieur d'une même procédure, on ne peut pas exécuter
2 fois cette ligne de code en utilisant une boucle. Ton code a été
réorganisé en tenant compte de ce qui précède.

'--------------------------
With
ThisWorkbook.VBProject.VBComponents(Worksheets(LaFeuille).CodeName).CodeModule
.AddFromString Code
End With
'--------------------------

Je laisse à FxM et à Modeste le soin de nous expliquer le pourquoi