Bouton

Bonjour,

Dans mon fichier je dois répéter une manœuvre, j'aimerai bien savoir si il est possible d'aller plus vite.

Je dois placer des boutons "ok" et "ko" à chaque ligne, le problème est qu'il faut à chaque fois affecter une nouvelle macro pour chaque bouton.

Ces opérations risquent de me prendre beaucoup de temps, si vous avez une idée je suis preneur.

Merci

Bonsoir,

Tout simplement 2 boutons en tout et pour tout ! Et 2 macros ! Et sans utiliser l'enregistreur car pourquoi mettre 9 lignes de code là où une seule est nécessaire !

Cordialement.

Bonjour,

voici un exemple,

Sub AjoutBouton()
Dim Nom As String, i As Long, y As Integer
Dim l As Double, t As Double, w As Double, h As Double
Dim Bouton As Object

EffaceBouton

For y = 10 To 11
 For i = 5 To 42
    With Cells(i, y) 'colonne J
      l = .Left + 1
      t = .Top + 1
      w = .Width - 1
      h = .Height - 1
    End With

   With ActiveSheet
       Set Bouton = .Buttons.Add(l, t, w, h)
       With Bouton
        Select Case y
          Case 10: .Characters.Text = "OK": .OnAction = "OKV"
          Case 11: .Characters.Text = "KO": .OnAction = "KOV"
         End Select
       End With
   End With
 Next i
Next y
End Sub

Sub EffaceBouton()
For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = "OK" Then sh.Delete
Next
End Sub

Sub OKV()
Nom = Application.Caller
rw = ActiveSheet.Shapes(Nom).TopLeftCell.Row
Cells(rw, 8).Interior.Color = 5287936
End Sub

Sub KOV()
Nom = Application.Caller
rw = ActiveSheet.Shapes(Nom).TopLeftCell.Row
Cells(rw, 8).Interior.Color = 255
End Sub

edit:

modifier la macro:

Sub EffaceBouton()
For Each sh In ActiveSheet.Shapes
If sh.TextFrame.Characters.Text = "OK" Then sh.Delete
Next
End Sub

par celle-ci:

Sub EffaceBouton()
For Each sh In ActiveSheet.Shapes
 With sh.TextFrame.Characters
   If .Text = "OK" Or .Text = "KO" Then sh.Delete
 End With
Next
End Sub

Bonjour,

Un grand merci pour les macro, l'ajout des boutons de manière automatique est super.