Discussion :

[bencelui]

Bonjour à tous,

Je cherche à rajouter une condition "If" si l'utilisateur utilise la recopie de cellule par tirage (petite croix sous la première cellule)
J'essaie avec une condition sur "autofill" ? J'ai bon, je chauffe ?

Pour tout expliquer, j'ai une macro qui demande une validation si une cellule est effacée ou modifiée. Ca fonctionne du feu de dieu si on sélectionne une ou plusieurs cellules, mais pas si l'on utilise la recopie...

Merci de vos contributions si vous avez une idée

Bon Week-end,
Amicalement

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
If Target.Cells(1, 1) = "" Then
      If Target.Cells.Count >= 1 Then
     Reponse = MsgBox("Voulez-vous modifier ?", vbYesNo + vbExclamation + vbDefaultButton2)
 
' c'est ici que je souhaite ajouter un:
 
' Else
' If Autofill = "" then    
 
  If Reponse = vbNo Then
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    Else
        Exit Sub
    End If
End If
End If

[patricktoulon]

re
bonsoir
il n'existe pas a proprement parler de fonction VBA excel de detection d'autofill
cela dit tu peux t'en faire une

puisque pour faire un autofill il te faut :

selectionner la 1 ere cellule et pour que l'evenement selection change soit pris en compte il faut lacher le bouton de la souris
ensuite tu chope la poignée et tu etire puis lache le bouton de la souris et la a nouveau l'evenement selection change se déclance
et bien il te suffit de memoriser avec une variable static la premiere selection (1 cellule) et comparer avec la selection la 2d fois

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static c1 As Range
    Dim cel1 As Range
    If Target.Cells.Count = 1 Then
        Set c1 = Selection.Cells(1)
        Debug.Print c1.Address
    Else
        If Target.Cells.Count > 1 And Not c1 Is Nothing Then
            If Selection.Column = c1.Column Then
                Set cel1 = c1
                Set c1 = Selection
                If Selection.Cells(1).Address = cel1.Address And Selection.Columns.Count = 1 Then
                    MsgBox "vous avez étiré la cellule " & cel1.Address & " sur la plage " & c1.Address
                    Set c1 = Nothing
                End If
            End If
        End If
    End If
End Sub

voila tu l'a ton evenement After_AutoFill

[patricktoulon]

correction d'une coquille
l'effet se faisait mement quand on etirais pas mais que la selection finale etait cohérente avec le resultat d'autofill sauf que c'etait une simple selection
et pour parfaire l'effet du pseudo evenement on teste aussi le formular1c1
et a la place du msgbox on appelle ce dit" pseudo evenement " que j'ai appeler "selection_autoFill"

les actions a faire en fonction du autofill se feront dans ce pseudo evenement

voila
tu met ca dans ton module du sheets et tu code dans l'evenement

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static c1 As Range
    Dim cel1 As Range
    If Target.Cells.Count = 1 Then
        Set c1 = Selection.Cells(1)
        Debug.Print c1.Address
    Else
        If Target.Cells.Count > 1 And Not c1 Is Nothing Then
            If Selection.Column = c1.Column Then
                Set cel1 = c1
                Set c1 = Selection
                If Selection.Cells(1).Address = cel1.Address And Selection.Columns.Count = 1 Then
                    If cel1.FormulaR1C1 = c1.Cells(c1.Cells.Count).FormulaR1C1 And cel1.FormulaR1C1 <> "" Then selection_AutoFill cel1, c1
                    Set c1 = Nothing
                End If
            End If
        End If
    End If
End Sub
''
'
'Pseudo evenement selection_AutoFill
Private Sub selection_AutoFill(ByRef cel1 As Range, ByRef CSelection As Range)
 
    MsgBox "vous avez étiré la cellule " & cel1.Address & " sur la plage " & CSelection.Address
End Sub

voila l'effet est vraiment bloffant

[bencelui]

Bonsoir et tout d'abord merci !!!!

Exactement ce que je cherchais à faire....

Juste, ça ne fonctionne que si l'on tire vers le bas... Pas a droite, a gauche ni en haut...

Je vais chercher de mon coté comment améliorer ce super code....

En tout cas, un grand merci....

J'avance, au lieu de tourner en rond !

Bonne soirée
Bien cordialement

[patricktoulon]

re
ben oui l'autofill ne fonctionne que sur une colonne donc droite et gauche c'est non
maintenant si tu veux modifier ce point ca change tout ca n'est plus un surveillant de autofill mais un nouveau autofill amélioré si je puis m'exprimer ainsi
pour le bas vers le haut je peux modifier le test de la cellule1 avec la cellule.count de la 2d selection et la transformer pour que le test se fasse de haut en bas et bas en haut

c'est rigolo ton truc

[patricktoulon]

voila pour les deux sens

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
Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static c1 As Range
    Dim cel1 As Range, F As Boolean
    If Target.Cells.Count = 1 Then
        Set c1 = Selection.Cells(1)
        Debug.Print c1.Address
    Else
        If Target.Cells.Count > 1 And Not c1 Is Nothing Then
            If Selection.Column = c1.Column Then
                Set cel1 = c1
                Set c1 = Selection
                If Selection.Cells(1).Address = cel1.Address Or Selection.Cells(Selection.Cells.Count).Address = cel1.Address And Selection.Columns.Count = 1 Then
                    F = True
                    For Each cel In Selection.Cells
                        If cel.FormulaR1C1 <> Selection.Cells(1).FormulaR1C1 Then F = False
                    Next
                    If F = True Then selection_AutoFill cel1, c1
                    Set c1 = Nothing
                End If
            End If
        End If
    End If
End Sub
'
'
'
'Pseudo evenement selection_AutoFill
Private Sub selection_AutoFill(ByRef cel1 As Range, ByRef CSelection As Range)
    MsgBox "vous avez étiré la cellule " & cel1.Address & " sur la plage " & CSelection.Address
End Sub

[patricktoulon]

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static c1 As Range
    Dim cel1 As Range, F As Boolean
    If Target.Cells.Count = 1 Then
        Set c1 = Selection.Cells(1)
        Debug.Print c1.Address
    Else
        If Target.Cells.Count > 1 And Not c1 Is Nothing Then
             Set cel1 = c1
            Set c1 = Selection
            If Selection.Cells(1).Address = cel1.Address Or Selection.Cells(Selection.Cells.Count).Address = cel1.Address Then
                F = True
                For Each cel In Selection.Cells
                    If cel.FormulaR1C1 <> Selection.Cells(1).FormulaR1C1 Then F = False
                Next
                If F = True Then selection_AutoFill cel1, c1
                Set c1 = Nothing
            End If
 
        End If
    End If
End Sub
'
'
'Pseudo evenement selection_AutoFill
Private Sub selection_AutoFill(ByRef cel1 As Range, ByRef CSelection As Range)
    MsgBox "vous avez étiré la cellule " & cel1.Address & " sur la plage " & CSelection.Address
End Sub