M
Marcoleschams
Guest
Bonjour,
Tout d'abord, je ne sais pas si je peux me qualifier de "débutant", il y a temps de temps que je "bidouille" en VBA ! Disons que je me forme comme le fait un autodidacte, aussi les explications que j'attends, nécessitent que l'on me mâche un peu la démarche.
J'élabore un document excel qui nécessite de gérer des boites à bouton. Ce document est assez lourd pour le présenter ici, aussi j'ai construit un autre document excel (appeler "essai case à cocher.xls") uniquement à fin de travailler sur le problème.
Avec les renseignements que j'ai pris ici :
Les meilleurs sources pour Excel - Club d'entraide des développeurs francophones - Club des décideurs et professionnels en Informatique
VBA et les collections d'objets.
J'ai une procédure (macro InitOption) qui me permet de créer un événement (mettre la cellule au droit de la case à cocher à la valeur vrai ou faux en fonction de la présence de la coche ou pas).
A l'ouverture du document, celle-ci marche très bien et me satisfait.
Mais cette procédure (macro InitOption) perd toute son activité dés que je crée ou supprime des cases à cocher malgré son rechargement dans la fonction de création ou de suppression, mais aussi quand je lance l'éditeur VBA.
J'ai affecté cette macro à une commande clavier et c'est uniquement avec celle-ci que j'arrive à la réactiver. Naturellement, ce n'est pas avec un raccourcie clavier que je veux que cela fonctionne.
A fin d'essai, dans le document, j'ai mis un bouton de commande ("Met cases à cochées") affectée à une macro (Private Sub CommandButton1_Click()) qui crée 5 checkbox appelées A1, A2,…,A5 dans les cellules B 1 à B5 et un autre bouton ("Défait les cases à cochées") qui me les supprime. (Macro : Private Sub CommandButton2_Click())
Ces 2 macros font le travail que je demande et retourne dans "InitOption", mais cette dernière opération est, comme je le disais, sans effet.
Voici mon VBA :
Dans Feuil1 (Feuil1) &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub CommandButton1_Click()
CreCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub
Private Sub CommandButton2_Click()
EffaceCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub
Function CreCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number = 1004 Then 'Vérifie si cela est correct
Worksheets("Feuil1").OLEObjects.Add ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False, Left:=180, Top:=10, Width:=18.75, Height:=12
Set Chbx = ActiveSheet.OLEObjects("CheckBox1")
With Chbx
.Top = Cells(j, 1).Top
.Left = Cells(j, 2).Left
.Object.Caption = "" 'Retire le nom de la case
.Object.SpecialEffect = 0 'Met une ombre
.Name = "A" & j 'le renome en A quelque chose
End With
Else
MonMessage ("créer ")
j = 5
End If
Next j
End Function
Function EffaceCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number <> 1004 Then 'Vérifie si cela est correct
Chbx.Delete
Cells(j, 1) = ""
Else
MonMessage ("effacer")
j = 5
End If
Next j
End Function
Function MonMessage(LeMot As String)
MsgBox (Chr(13) & "***********************************" & Chr(13) & _
"***** Il n'y a rien à " & LeMot & " ****" & Chr(13) & _
"***********************************")
End Function
Dans ThisWorkbook &&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Sub Workbook_Open()
InitOption
End Sub
Dans Module1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Collect As Collection
Public Sub InitOption()
Dim Obj As OLEObject
Dim Cl As Classe1
Set Collect = New Collection
'boucle sur les objets de la Feuil1
For Each Obj In Feuil1.OLEObjects
'verifie s'il s'agit d'un Checkbox
If TypeOf Obj.Object Is MSForms.CheckBox Then
Set Cl = New Classe1
Set Cl.CheckBoxGroup = Obj.Object
Collect.Add Cl
End If
Next Obj
MsgBox ("initialisation faite")
End Sub
Dans Classe1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public WithEvents CheckBoxGroup As MSForms.CheckBox
Public Sub CheckBoxGroup_Click()
Cells(CheckBoxGroup.TopLeftCell.Row, 1) = CheckBoxGroup.Value
Cells(1, 3).Select
End Sub
Je veux bien faire parvenir ce document xls si cela peut aider.
Merci d'avance Marc
Tout d'abord, je ne sais pas si je peux me qualifier de "débutant", il y a temps de temps que je "bidouille" en VBA ! Disons que je me forme comme le fait un autodidacte, aussi les explications que j'attends, nécessitent que l'on me mâche un peu la démarche.
J'élabore un document excel qui nécessite de gérer des boites à bouton. Ce document est assez lourd pour le présenter ici, aussi j'ai construit un autre document excel (appeler "essai case à cocher.xls") uniquement à fin de travailler sur le problème.
Avec les renseignements que j'ai pris ici :
Les meilleurs sources pour Excel - Club d'entraide des développeurs francophones - Club des décideurs et professionnels en Informatique
VBA et les collections d'objets.
J'ai une procédure (macro InitOption) qui me permet de créer un événement (mettre la cellule au droit de la case à cocher à la valeur vrai ou faux en fonction de la présence de la coche ou pas).
A l'ouverture du document, celle-ci marche très bien et me satisfait.
Mais cette procédure (macro InitOption) perd toute son activité dés que je crée ou supprime des cases à cocher malgré son rechargement dans la fonction de création ou de suppression, mais aussi quand je lance l'éditeur VBA.
J'ai affecté cette macro à une commande clavier et c'est uniquement avec celle-ci que j'arrive à la réactiver. Naturellement, ce n'est pas avec un raccourcie clavier que je veux que cela fonctionne.
A fin d'essai, dans le document, j'ai mis un bouton de commande ("Met cases à cochées") affectée à une macro (Private Sub CommandButton1_Click()) qui crée 5 checkbox appelées A1, A2,…,A5 dans les cellules B 1 à B5 et un autre bouton ("Défait les cases à cochées") qui me les supprime. (Macro : Private Sub CommandButton2_Click())
Ces 2 macros font le travail que je demande et retourne dans "InitOption", mais cette dernière opération est, comme je le disais, sans effet.
Voici mon VBA :
Dans Feuil1 (Feuil1) &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub CommandButton1_Click()
CreCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub
Private Sub CommandButton2_Click()
EffaceCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub
Function CreCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number = 1004 Then 'Vérifie si cela est correct
Worksheets("Feuil1").OLEObjects.Add ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False, Left:=180, Top:=10, Width:=18.75, Height:=12
Set Chbx = ActiveSheet.OLEObjects("CheckBox1")
With Chbx
.Top = Cells(j, 1).Top
.Left = Cells(j, 2).Left
.Object.Caption = "" 'Retire le nom de la case
.Object.SpecialEffect = 0 'Met une ombre
.Name = "A" & j 'le renome en A quelque chose
End With
Else
MonMessage ("créer ")
j = 5
End If
Next j
End Function
Function EffaceCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number <> 1004 Then 'Vérifie si cela est correct
Chbx.Delete
Cells(j, 1) = ""
Else
MonMessage ("effacer")
j = 5
End If
Next j
End Function
Function MonMessage(LeMot As String)
MsgBox (Chr(13) & "***********************************" & Chr(13) & _
"***** Il n'y a rien à " & LeMot & " ****" & Chr(13) & _
"***********************************")
End Function
Dans ThisWorkbook &&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Sub Workbook_Open()
InitOption
End Sub
Dans Module1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Collect As Collection
Public Sub InitOption()
Dim Obj As OLEObject
Dim Cl As Classe1
Set Collect = New Collection
'boucle sur les objets de la Feuil1
For Each Obj In Feuil1.OLEObjects
'verifie s'il s'agit d'un Checkbox
If TypeOf Obj.Object Is MSForms.CheckBox Then
Set Cl = New Classe1
Set Cl.CheckBoxGroup = Obj.Object
Collect.Add Cl
End If
Next Obj
MsgBox ("initialisation faite")
End Sub
Dans Classe1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public WithEvents CheckBoxGroup As MSForms.CheckBox
Public Sub CheckBoxGroup_Click()
Cells(CheckBoxGroup.TopLeftCell.Row, 1) = CheckBoxGroup.Value
Cells(1, 3).Select
End Sub
Je veux bien faire parvenir ce document xls si cela peut aider.
Merci d'avance Marc