création checkBox apres Coller

[achraf26]

Bonjour,
j'avais mis un macro pour quand je saisie un code dans la colonne A, un check box crée automatiquement à la colonne E,
par contre j'ai eu un soucie Quand je copie la cellule de G12:H12, à la colonne A le check box n'est pas crée automatiquement.
Quelqu'un a une solution svp
Merci

 

[job75]

Re : création checkBox apres Coller

Bonjour achraf26,

Remplacez :

'---
    If Not Intersect(Target, [A:A]) Is Nothing And Target.Count = 1 Then
        If Target <> "" Then

par :

'---
    If Target.Column = 1 Then
        If Target(1) <> "" Then

PS : sur XLD on n'aime pas trop quand il n'y a pas de réponse :

https://www.excel-downloads.com/threads/cellule-active-doubleclik-macro.234019/

A+

 

[job75]

Re : création checkBox apres Coller

Re,

Si par copier-coller ou effacement on veut faire des modifications multiples :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, h#, g#, l#, c#
Set r = Intersect(Target, [A:A])
If r Is Nothing Then Exit Sub
If r.Count > 1000 Then 'limite à adapter...
    MsgBox "Plage trop grande !", 48
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
End If
For Each r In r 'si modifications multiples
    h = Range("E" & r.Row).Top
    g = Range("E" & r.Row).Left
    l = Range("E" & r.Row).Width
    c = g + l / 2 - 8
    If r <> "" Then
        With Me.CheckBoxes.Add(c, h, 0, 0)
            .Text = ""
            .Value = xlOff
            .LinkedCell = "F" & r.Row
            .Name = "CheckBox_E" & r.Row
        End With
    Else
        On Error Resume Next
        Me.Shapes.Range("CheckBox_E" & r.Row).Delete
        On Error GoTo 0
    End If
Next
End Sub

A+

 

[achraf26]

Re : création checkBox apres Coller

Re,

Si par copier-coller ou effacement on veut faire des modifications multiples :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, h#, g#, l#, c#
Set r = Intersect(Target, [A:A])
If r Is Nothing Then Exit Sub
If r.Count > 1000 Then 'limite à adapter...
    MsgBox "Plage trop grande !", 48
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    Exit Sub
End If
For Each r In r 'si modifications multiples
    h = Range("E" & r.Row).Top
    g = Range("E" & r.Row).Left
    l = Range("E" & r.Row).Width
    c = g + l / 2 - 8
    If r <> "" Then
        With Me.CheckBoxes.Add(c, h, 0, 0)
            .Text = ""
            .Value = xlOff
            .LinkedCell = "F" & r.Row
            .Name = "CheckBox_E" & r.Row
        End With
    Else
        On Error Resume Next
        Me.Shapes.Range("CheckBox_E" & r.Row).Delete
        On Error GoTo 0
    End If
Next
End Sub

A+

Bonsoir ,
j'ai pas compris le code, (si par copier/coller) ?
Merci Job

 

[job75]

Re : création checkBox apres Coller

Re,

j'ai pas compris le code, (si par copier/coller) ?

Bah pour tester renseignez la plage G12:H15.

Puis collez-la sur A5...

Puis effacez A5:B8...

Bonne nuit.