Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Excel XP - macro création checkbox auto + copier-coller plage

2 réponses
Avatar
Congelator
Salut à toutes et à tous,
J'ai besoin de vos esprits géniaux pour résoudre mon problème...
Je dois créer une macro (ou directement du VBA) dans un document Excel XP
pour un utilisateur mais il me pose une colle... alors je vous la soumet :

J'ai des données déjà inscrites de A5 à H17.
J6:J17 et L6:L17 contiennent les données que j'utiliserai plus bas comme
liste de valeurs.
Il faudrait que je puisse :
1- créer ces listes de valeurs sur une feuille cachée (feuil2) du même
classeur, ça c'est fait... mais je n'arrive pas à les utiliser sur la feuil1,
uniquement sur feuil2
2- créer une macro qui, depuis la cellule active (p.ex A50)
2.1 - sélectionne A5:H17 et fasse un copier-coller depuis cette cellule
(A50:H67) ainsi que des listes en J et L (50:67) provenant de feuil2
2.2 - me crée automatiquement 10 checkbox "OK" en I (en I50:I67)
2.3 - idem avec 3 checkbox "OK" en K (en K50:K53)
2.4 - idem avec 1 checkbox "OK" en M (en M50)

Voilà, c'est juste ça... Yaka...! Je plaisante... :-) Si c'était si simple,
ma macro fonctionnerait déjà...!! Si quelqu'un a une solution, je suis
preneur.
Merci d'avance à toutes celles et ceux qui voudront bien se pencher sur mon
cas.
--
Céd / Lausanne

2 réponses

Avatar
Hervé
Salut,
Il faudra adapter ou revenir avec plus de précision.
La copie et création des cases à cocher ne fonctionne que si tu clique dans
la cellule A50. Les listes servant à alimenter les Combos doivent se trouver
(pour le test) dans les plages "A1:A12" et "C1:C12" de la feuille "Feuil2".

A mettre dans le module de la feuille "Feuil1" :
'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ctrl As Shape
Dim I As Integer
'si A50 sélectionnée
If Not Intersect([A50], Target) Is Nothing Then
'suspend les évennements
Application.EnableEvents = False
'supression de toutes les cases à cocher
'éventuellement présentent sur la feuille
For I = Worksheets("Feuil1").Shapes.Count To 1 Step -1
If Worksheets("Feuil1").Shapes(I).FormControlType = 1 Then
Worksheets("Feuil1").Shapes(I).Delete
End If
Next I
'copy des valeurs
[A5:H17].Copy Target
Worksheets("Feuil2").[A1:C12].Copy Range("J" & Target.Row)
'création des 17 cases à cocher en colonne "I"
For I = 1 To 17
With Range("I" & Target.Row - 1 + I)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_I_" & I
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
Next
'création des 3 cases à cocher en colonne "K"
For I = 1 To 3
With Range("K" & Target.Row + I)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_K_" & I
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
Next
'création de la case à cocher en colonne "M"
With Range("M" & Target.Row)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_M_1"
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
'rétabli
Application.EnableEvents = True
End If
Set Ctrl = Nothing
End Sub
'---------------------------------------------------------
A mettre dans un module standard du classeur :
'---------------------------------------------------------
Sub Liste()
Dim Fe As Worksheet
Dim Ctrl As Shape

Set Fe = Worksheets("Feuil1")

On Error Resume Next
Fe.Shapes("Combo1").Delete
Fe.Shapes("Combo2").Delete
On Error GoTo 0

With Fe.[B2]
Set Ctrl = Fe.Shapes.AddFormControl(xlDropDown, _
.Left, _
.Top, _
.Width, _
.Height)
End With

With Ctrl
.Name = "Combo1"
.OnAction = "Combo1"
.ControlFormat.ListFillRange = "Feuil2!A1:A12"
End With

With Fe.[C2]
Set Ctrl = Fe.Shapes.AddFormControl(xlDropDown, _
.Left, _
.Top, _
.Width, _
.Height)
End With

With Ctrl
.Name = "Combo2"
.OnAction = "Combo2"
.ControlFormat.ListFillRange = "Feuil2!C1:C12"
End With

'fait défiler la feuille afin de rafraichir
'l'affichage
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 1

Set Ctrl = Nothing
Set Fe = Nothing
End Sub

Sub Combo1()
'retourne la valeur choisie
With Worksheets("Feuil1").DropDowns("Combo1")
MsgBox .List(.ListIndex)
End With
End Sub

Sub Combo2()
'retourne la valeur choisie
With Worksheets("Feuil1").DropDowns("Combo2")
MsgBox .List(.ListIndex)
End With
End Sub

Sub MacroChk()
Dim Cocher As String
Dim I As Integer
'retourne le nom des cases cochées
For I = 1 To Worksheets("Feuil1").Shapes.Count
With Worksheets("Feuil1").Shapes(I)
If .FormControlType = 1 _
And .ControlFormat.Value = 1 Then
Cocher = Cocher & .Name & vbCrLf
End If
End With
Next I
MsgBox Cocher
End Sub
'--------------------------------------------------------
Pour les listes de validation, il n'est pas possible de faire référence à
une autre feuille que celle où elles se trouvent.
Dans ce cas, tu peux utiliser des Combos issus de la barre d'outils
"Formulaires" qui eux peuvent faire référence à une plage située ailleur que
sur la feuille où ils se trouvent.
Pour l'exemple, exécute la proc "Liste" qui va créer 2 Combos sur les
cellules B2 et C2 de la feuille "Feuil1", un clic dans les combo te retourne
la valeur choisie par l'intermédiaire d'un MsgBox.
Pour les case à cocher, un clic sur l'une d'entre elles retoure le nom de
celles qui sont cochées par l'intermédiaire d'un MsgBox.
Revient si tu veux plus.
Hervé.

"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message
news:
Salut à toutes et à tous,
J'ai besoin de vos esprits géniaux pour résoudre mon problème...
Je dois créer une macro (ou directement du VBA) dans un document Excel XP
pour un utilisateur mais il me pose une colle... alors je vous la soumet :

J'ai des données déjà inscrites de A5 à H17.
J6:J17 et L6:L17 contiennent les données que j'utiliserai plus bas comme
liste de valeurs.
Il faudrait que je puisse :
1- créer ces listes de valeurs sur une feuille cachée (feuil2) du même
classeur, ça c'est fait... mais je n'arrive pas à les utiliser sur la


feuil1,
uniquement sur feuil2
2- créer une macro qui, depuis la cellule active (p.ex A50)
2.1 - sélectionne A5:H17 et fasse un copier-coller depuis cette cellule
(A50:H67) ainsi que des listes en J et L (50:67) provenant de feuil2
2.2 - me crée automatiquement 10 checkbox "OK" en I (en I50:I67)
2.3 - idem avec 3 checkbox "OK" en K (en K50:K53)
2.4 - idem avec 1 checkbox "OK" en M (en M50)

Voilà, c'est juste ça... Yaka...! Je plaisante... :-) Si c'était si


simple,
ma macro fonctionnerait déjà...!! Si quelqu'un a une solution, je suis
preneur.
Merci d'avance à toutes celles et ceux qui voudront bien se pencher sur


mon
cas.
--
Céd / Lausanne


Avatar
Congelator
Salut Hervé,

Un grand merci pour ton aide. Tu m'as fait le 99,9 % du boulot donc il ne me
reste "plus qu'à" adapter.

Encore une fois MERCI !

Céd

"Hervé" wrote:

Salut,
Il faudra adapter ou revenir avec plus de précision.
La copie et création des cases à cocher ne fonctionne que si tu clique dans
la cellule A50. Les listes servant à alimenter les Combos doivent se trouver
(pour le test) dans les plages "A1:A12" et "C1:C12" de la feuille "Feuil2".

A mettre dans le module de la feuille "Feuil1" :
'----------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ctrl As Shape
Dim I As Integer
'si A50 sélectionnée
If Not Intersect([A50], Target) Is Nothing Then
'suspend les évennements
Application.EnableEvents = False
'supression de toutes les cases à cocher
'éventuellement présentent sur la feuille
For I = Worksheets("Feuil1").Shapes.Count To 1 Step -1
If Worksheets("Feuil1").Shapes(I).FormControlType = 1 Then
Worksheets("Feuil1").Shapes(I).Delete
End If
Next I
'copy des valeurs
[A5:H17].Copy Target
Worksheets("Feuil2").[A1:C12].Copy Range("J" & Target.Row)
'création des 17 cases à cocher en colonne "I"
For I = 1 To 17
With Range("I" & Target.Row - 1 + I)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_I_" & I
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
Next
'création des 3 cases à cocher en colonne "K"
For I = 1 To 3
With Range("K" & Target.Row + I)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_K_" & I
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
Next
'création de la case à cocher en colonne "M"
With Range("M" & Target.Row)
Set Ctrl = Me.Shapes.AddFormControl(xlCheckBox, _
.Left, _
.Top, _
.Width, _
.Height)
End With
With Ctrl
.Name = "Chk_M_1"
.OnAction = "MacroChk"
.TextFrame.Characters.Text = "OK"
End With
'rétabli
Application.EnableEvents = True
End If
Set Ctrl = Nothing
End Sub
'---------------------------------------------------------
A mettre dans un module standard du classeur :
'---------------------------------------------------------
Sub Liste()
Dim Fe As Worksheet
Dim Ctrl As Shape

Set Fe = Worksheets("Feuil1")

On Error Resume Next
Fe.Shapes("Combo1").Delete
Fe.Shapes("Combo2").Delete
On Error GoTo 0

With Fe.[B2]
Set Ctrl = Fe.Shapes.AddFormControl(xlDropDown, _
.Left, _
.Top, _
.Width, _
.Height)
End With

With Ctrl
.Name = "Combo1"
.OnAction = "Combo1"
.ControlFormat.ListFillRange = "Feuil2!A1:A12"
End With

With Fe.[C2]
Set Ctrl = Fe.Shapes.AddFormControl(xlDropDown, _
.Left, _
.Top, _
.Width, _
.Height)
End With

With Ctrl
.Name = "Combo2"
.OnAction = "Combo2"
.ControlFormat.ListFillRange = "Feuil2!C1:C12"
End With

'fait défiler la feuille afin de rafraichir
'l'affichage
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 1

Set Ctrl = Nothing
Set Fe = Nothing
End Sub

Sub Combo1()
'retourne la valeur choisie
With Worksheets("Feuil1").DropDowns("Combo1")
MsgBox .List(.ListIndex)
End With
End Sub

Sub Combo2()
'retourne la valeur choisie
With Worksheets("Feuil1").DropDowns("Combo2")
MsgBox .List(.ListIndex)
End With
End Sub

Sub MacroChk()
Dim Cocher As String
Dim I As Integer
'retourne le nom des cases cochées
For I = 1 To Worksheets("Feuil1").Shapes.Count
With Worksheets("Feuil1").Shapes(I)
If .FormControlType = 1 _
And .ControlFormat.Value = 1 Then
Cocher = Cocher & .Name & vbCrLf
End If
End With
Next I
MsgBox Cocher
End Sub
'--------------------------------------------------------
Pour les listes de validation, il n'est pas possible de faire référence à
une autre feuille que celle où elles se trouvent.
Dans ce cas, tu peux utiliser des Combos issus de la barre d'outils
"Formulaires" qui eux peuvent faire référence à une plage située ailleur que
sur la feuille où ils se trouvent.
Pour l'exemple, exécute la proc "Liste" qui va créer 2 Combos sur les
cellules B2 et C2 de la feuille "Feuil1", un clic dans les combo te retourne
la valeur choisie par l'intermédiaire d'un MsgBox.
Pour les case à cocher, un clic sur l'une d'entre elles retoure le nom de
celles qui sont cochées par l'intermédiaire d'un MsgBox.
Revient si tu veux plus.
Hervé.

"Congelator" <congelator(a_effacer)@hotmail.com> a écrit dans le message
news:
> Salut à toutes et à tous,
> J'ai besoin de vos esprits géniaux pour résoudre mon problème...
> Je dois créer une macro (ou directement du VBA) dans un document Excel XP
> pour un utilisateur mais il me pose une colle... alors je vous la soumet :
>
> J'ai des données déjà inscrites de A5 à H17.
> J6:J17 et L6:L17 contiennent les données que j'utiliserai plus bas comme
> liste de valeurs.
> Il faudrait que je puisse :
> 1- créer ces listes de valeurs sur une feuille cachée (feuil2) du même
> classeur, ça c'est fait... mais je n'arrive pas à les utiliser sur la
feuil1,
> uniquement sur feuil2
> 2- créer une macro qui, depuis la cellule active (p.ex A50)
> 2.1 - sélectionne A5:H17 et fasse un copier-coller depuis cette cellule
> (A50:H67) ainsi que des listes en J et L (50:67) provenant de feuil2
> 2.2 - me crée automatiquement 10 checkbox "OK" en I (en I50:I67)
> 2.3 - idem avec 3 checkbox "OK" en K (en K50:K53)
> 2.4 - idem avec 1 checkbox "OK" en M (en M50)
>
> Voilà, c'est juste ça... Yaka...! Je plaisante... :-) Si c'était si
simple,
> ma macro fonctionnerait déjà...!! Si quelqu'un a une solution, je suis
> preneur.
> Merci d'avance à toutes celles et ceux qui voudront bien se pencher sur
mon
> cas.
> --
> Céd / Lausanne