Changer le nom des boutons de commandes

Résolu/Fermé
kit24be Messages postés 46 Date d'inscription samedi 12 janvier 2013 Statut Membre Dernière intervention 22 octobre 2017 - 16 févr. 2014 à 10:41
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 - 16 févr. 2014 à 20:43
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

A voir également:

4 réponses

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 777
Modifié par Patrice33740 le 16/02/2014 à 13:45
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
0
kit24be Messages postés 46 Date d'inscription samedi 12 janvier 2013 Statut Membre Dernière intervention 22 octobre 2017 1
16 févr. 2014 à 17:19
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
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 777
Modifié par Patrice33740 le 16/02/2014 à 19:39
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
0
kit24be Messages postés 46 Date d'inscription samedi 12 janvier 2013 Statut Membre Dernière intervention 22 octobre 2017 1
16 févr. 2014 à 19:54
Cela marche super bien, un grand merci
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 777
16 févr. 2014 à 20:43
De rien, au plaisir de te relire sur le Forum

Cordialement
Paytrice
0