Changer le nom des boutons de commandes
Résolu
Bonjour,
je désire changer le nom des boutons de commande automatiquement par rapport a une liste de noms dans la colonne A. je crée les boutons automatiquement avec le code ci dessous.
Merci d'avance
Sub bouton()
Dim left, top, i As Integer
Dim code As String
Dim nbcells As Integer
nbcells = Application.WorksheetFunction.CountA(Range("$a:$a"))
Range("b1").Value = nbcells
left = 20
top = 10
i = 1
Range("a1").Select
For i = i To nbcells
top = top + 25
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, left:=left, top:=top, Width:=100, Height:= _
20).Select
Select Case i
Case Is = 12
top = 10
left = 130
Case Is = 24
top = 10
left = 240
Case Is = 36
top = 10
left = 350
Case Is = 48
top = 10
left = 460
Case Is = 60
top = 10
left = 570
Case Is = 72
top = 10
left = 680
Case Is = 84
top = 10
left = 770
Case Is = 96
top = 10
left = 880
End Select
If i = nbcells Then
Range("a1").Select
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
je désire changer le nom des boutons de commande automatiquement par rapport a une liste de noms dans la colonne A. je crée les boutons automatiquement avec le code ci dessous.
Merci d'avance
Sub bouton()
Dim left, top, i As Integer
Dim code As String
Dim nbcells As Integer
nbcells = Application.WorksheetFunction.CountA(Range("$a:$a"))
Range("b1").Value = nbcells
left = 20
top = 10
i = 1
Range("a1").Select
For i = i To nbcells
top = top + 25
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, left:=left, top:=top, Width:=100, Height:= _
20).Select
Select Case i
Case Is = 12
top = 10
left = 130
Case Is = 24
top = 10
left = 240
Case Is = 36
top = 10
left = 350
Case Is = 48
top = 10
left = 460
Case Is = 60
top = 10
left = 570
Case Is = 72
top = 10
left = 680
Case Is = 84
top = 10
left = 770
Case Is = 96
top = 10
left = 880
End Select
If i = nbcells Then
Range("a1").Select
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
4 réponses
-
Bonjour kit24be,
Essaies ce code :Sub bouton()
Const x As Integer = 20 'Abscisse du 1° bouton
Const y As Integer = 10 'Ordonnée du 1° bouton
Const w As Integer = 100 'Largeur du bouton
Const h As Integer = 20 'Hauteur du bouton
Const dx As Integer = w + 10 'Décalage des boutons en abscisse
Const dy As Integer = h + 5 'Décalage des boutons en ordonnée
Const nb As Integer = 12 'Nombre de boutons par colonne
Dim b As OLEObject 'Bouton
Dim i As Integer 'Incrément
Dim n As Integer 'Nombre de noms de boutons
n = Application.WorksheetFunction.CountA(Range("$a:$a"))
For i = 0 To n - 1
Set b = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1")
With b
.top = y + (i Mod nb) * dy
.left = x + Int(i / nb) * dx
.Width = w
.Height = h
.Name = "Btn " & i + 1
.Object.Caption = Cells(i + 1, "A").Value
End With
Next i
End Sub
Cordialement
Patrice -
Bonjour,
Un très grand merci pour ta réponse, ton code marche super bien. J'ai encore une question, pour que tous les boutons soient associés a une même macro ( recherche dans une liste par rapport a leurs noms en ouvrant un userform) que dois je faire?
Merci d'avance -
Re,
Dans ce cas, si tous les boutons lancent une seule et même macro, il me semble plus simple d'utiliser des boutons de formulaire plutôt que des boutons activeX.
Essaies ce code :Sub BoutonsFormulaire()
Const x As Integer = 60 'Abscisse du 1° bouton
Const y As Integer = 50 'Ordonnée du 1° bouton
Const w As Integer = 100 'Largeur du bouton
Const h As Integer = 20 'Hauteur du bouton
Const dx As Integer = w + 10 'Décalage des bouton en abscisse
Const dy As Integer = h + 5 'Décalage des bouton en ordonnée
Const nb As Integer = 12 'Nombre de boutons par colonne
Dim b As Button 'Bouton
Dim i As Integer 'Incrément
Dim n As Integer 'Nombre de noms de boutons
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
n = Application.WorksheetFunction.CountA(Range("$a:$a"))
For i = 0 To n - 1
'ActiveSheet.Buttons.Add(Left, Top, Width, Height)
Set b = ActiveSheet.Buttons.Add(x + Int(i / nb) * dx, _
y + (i Mod nb) * dy, w, h)
With b
.Name = "Btn " & i + 1
.Caption = Cells(i + 1, "A").Value
.OnAction = "ClicSurBouton"
End With
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub ClicSurBouton()
MsgBox Application.Caller
End Sub
Cordialement
Patrice -
Cela marche super bien, un grand merci
