Discussion :

[Kodomo]

Bonjour,

Je commence à utiliser VBA et souhaite créer une macro pour copier la ligne du bouton activé (et non de la ligne sélectionnée) et l’insérer juste en dessous.
J’ai trouvé une macro que permet de copier/insérer correctement la ligne sélectionnée mais ne trouve pas comment faire en sorte que ce soit la ligne du bouton.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Bouton3_Cliquer()
Dim iR&, i&, k&
    iR = ActiveCell.Row
    Rows(iR).Insert
    k = ActiveSheet.UsedRange.Columns.Count
    For i = 1 To k
    Cells(iR, i).Formula = Cells(iR + 1, i).Formula
    Next
End Sub

Pourriez-vous m’éclairer sur la fonction à utiliser pour sélectionner la ligne du bouton lui-même s’il vous plait ?
D'autre part j'aimerais que cette fonction recopie également le bouton. Or même en sélectionnant la ligne qui contient le bouton cela ne fonctionne pas .

Bonne journée .

[aalex_38]

Bonsoir,

Je n'ai pas excel sous la main la, mais le bouton n'est pas forcement lié a une cellule ou une ligne, cependant tu dois pouvoir utiliser la propriéte TOPLEFTCELL

[Kodomo]

Merci pour cette piste .
Entre temps j'ai trouvé un code à priori parfait pour mes besoins mais il me pose quelques soucis ...

Le code est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Option Explicit
 
Sub AddRow()
 
    Dim shpTemp As Shape
    Dim shpGroup As Shape
    Dim lngRow As Long
 
    Set shpTemp = LocateShapeGroup(Application.Caller)
    If shpTemp Is Nothing Then Exit Sub
 
    lngRow = shpTemp.TopLeftCell.Row
    Rows(lngRow).Copy
    Rows(lngRow).Insert Shift:=xlDown
    Cells(lngRow + 1, 1).ClearContents
    Application.CutCopyMode = False
 
    Set shpGroup = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    If Not shpGroup Is Nothing Then
        UpdateNames shpGroup
    End If
 
End Sub
 
Sub DeleteRow()
 
    Dim shpTemp As Shape
    Dim shpGroup As Shape
    Dim lngRow As Long
 
    Set shpTemp = LocateShapeGroup(Application.Caller)
    If shpTemp Is Nothing Then Exit Sub
 
    lngRow = shpTemp.TopLeftCell.Row
 
    If MsgBox("This will delete row " & lngRow & _
        ", ok to continue ?", vbYesNo, "delete Row ?") = vbNo Then Exit Sub
 
    shpTemp.Delete
    Rows(lngRow).Delete
 
End Sub
 
 
 
Function GetMaxIndex(ByVal Name As String) As Long
 
    Dim shpTemp As Shape
    Dim shpItem As Shape
    Dim lngIndex As Long
    Dim lngMaxIndex As Long
    Dim lngLen As Long
 
    Name = UCase(Name)
    lngLen = Len(Name)
    For Each shpTemp In ActiveSheet.Shapes
        If shpTemp.Type = msoGroup Then
            For Each shpItem In shpTemp.GroupItems
                If UCase(Left(shpItem.Name, lngLen)) = Name Then
                    lngIndex = CLng(Mid(shpItem.Name, lngLen + 1))
                    If lngIndex > lngMaxIndex Then
                        lngMaxIndex = lngIndex
                    End If
                End If
            Next
        End If
    Next
 
    GetMaxIndex = lngMaxIndex + 1
 
End Function
 
Function LocateShapeGroup(Name As String) As Shape
'
' Loop through shapes on sheet and locate Named shape in a group
'
    Dim shpTemp As Shape
    Dim shpItem As Shape
 
    For Each shpTemp In ActiveSheet.Shapes
        If shpTemp.Type = msoGroup Then
            For Each shpItem In shpTemp.GroupItems
                If shpItem.Name = Name Then
                    Set LocateShapeGroup = shpTemp
                    Exit Function
                End If
            Next
        End If
    Next
 
End Function
 
 
Sub UpdateNames(MyGroup As Shape)
 
    Dim shpTemp As Shape
    Dim lngIndex As Long
 
    For Each shpTemp In MyGroup.GroupItems
        If InStr(shpTemp.Name, "_") > 0 Then
            lngIndex = GetMaxIndex(Left(shpTemp.Name, InStr(shpTemp.Name, "_")))
            shpTemp.Name = Left(shpTemp.Name, InStr(shpTemp.Name, "_")) & lngIndex
        Else
            shpTemp.Name = shpTemp.Name & "_1"
        End If
    Next
 
End Sub

Cela fonctionne à la perfection sur des petits exemples. C'est très exactement ce que je cherche !

Mais dès que j'intègre de longues lignes avec des formules, un bug bloque le processus :

Erreur d'exécution 1004.
L'accès à ce membre n'est possible que pour un groupe

Le debogage m'indique que le problème vient de cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub UpdateNames(MyGroup As Shape)
(...)   
For Each shpTemp In MyGroup.GroupItems

Je ne comprends pas du tout quelle est l'origine de l'erreur et comment y remédier.
Pourriez-vous m'aider à comprendre et éradiquer ce bug s'il vous plait ?

[Kodomo]

Voici un fichier qui génère l'erreur, cela sera peut-être plus clair. Je n'arrive pas à joindre un fichier avec les macro sur developpez.com, il s'agit donc seulement de la version "sans macros" mais le code est strictement identique à celui donné plus haut.

Si l'erreur n'apparait pas au 1er essai il faut ajouter des éléments dans plus de colonnes de la même ligne (texte, fonctions, calculs, ...) et cliquer sur "add" plusieurs fois.

Merci pour votre aide .


Edit : une solution à base de boutons de commande semble complexe et peu usitée par les codeurs, je vais me diriger vers une solution plus pratique...