XL 2019 Copier coller une case à cocher avec cellules liées.

Twixman

XLDnaute Nouveau
Bonjour,

Voici mon problème:

J'ai une case à cocher en B3 avec la cellule liée C3 et j'aimerais la copier en B4:B100 tout en gardant les cellules à côté liées (B4->C4, B5->C5, .......), puis copier B3:B100 et coller en D3:D100.

Et ainsi de suite.

Tout cela pour créer une énorme liste avec différents choix.

Quelqu'un aurait-il la solution?

Merci.
 

job75

XLDnaute Barbatruc
Bonjour Twixman,

Si la Case à cocher en B3 est bien un contrôle de formulaire avec cellule liée en C3 exécutez cette macro :
VB:
Sub CopierObjet()
Dim o As Object, MaCase As Object, x#, y#, c As Range
Application.ScreenUpdating = False
With ActiveSheet 'à adapter éventuellement
    '---RAZ---
    For Each o In ActiveSheet.DrawingObjects
        If TypeName(o) = "CheckBox" Then If Replace(o.LinkedCell, "$", "") = "C3" Then Set MaCase = o Else o.Delete
    Next o
    '---duplication---
    .[C3] = False 'True
    x = MaCase.Left - .[B3].Left
    y = MaCase.Top - .[B3].Top
    For Each c In .[B4:B100,D3:D100]
        With MaCase.Duplicate
            .Left = c.Left + x
            .Top = c.Top + y
            .LinkedCell = c(1, 2).Address
            c(1, 2) = False 'True
        End With
    Next c
End With
End Sub
A+
 

job75

XLDnaute Barbatruc
S'il s'agit d'un contrôle ActiveX la copie se fera avec cette macro :
VB:
Sub CopierObjet()
Dim o As Object, MaCase As Object, x#, y#, c As Range
Application.ScreenUpdating = False
With ActiveSheet 'à adapter éventuellement
    '---RAZ---
    For Each o In ActiveSheet.OLEObjects
        If TypeName(o.Object) = "CheckBox" Then If Replace(o.LinkedCell, "$", "") = "C3" Then Set MaCase = o Else o.Delete
    Next o
    '---duplication---
    .[C3] = False 'True
    x = MaCase.Left - .[B3].Left
    y = MaCase.Top - .[B3].Top
    For Each c In .[B4:B100,D3:D100]
        With MaCase.Duplicate
            .Left = c.Left + x
            .Top = c.Top + y
            .LinkedCell = c(1, 2).Address
            c(1, 2) = False 'True
        End With
    Next c
End With
End Sub
Chez moi l'exécution prend beaucoup plus de temps.
 

job75

XLDnaute Barbatruc
En B3 vous avez mis un contrôle de formulaire donc c'est la macro du post #2 qui doit être utilisée.

Et au départ il ne doit y avoir qu'une seule case à cocher avec cellule liée C3 dans la feuille, voyez le fichier joint.
 

Fichiers joints

Discussions similaires


Haut Bas