Ctrl+C /Ctrl+V incompatible avec "Private Sub Worksheet_SelectionChange" ?

Version imprimable

Bonjour,

J'ai une feuille excel avec le code ci-dessous.
Sur cette feuille j'aimerai coller des éléments manuellement par Ctrl+C /Ctrl+V.
Problème, dès que je sélectionne une cellule, pour y coller mes élément, une "moulinette" se lance durant 1s (le curseur de la sourie clignote) et ensuite impossible de coller (Ctrl+V) mes éléments. On à l'impression que la "moulinette" vide la mémoire de ce qui à été copié.
Le "coller" (Ctrl+V) fonctionne uniquement si je ne clic pas sur la feuille, mais dans ce cas les élément sont collé sur la cellule ayant été sélectionnée en dernier, ce qui n'est pas forcément intéressant.

En isolant cette partie du code, "Private Sub Worksheet_SelectionChange" le problème disparaît.
J'aimerais pouvoir à la fois faire de Ctrl+C /Ctrl+V sur l'ensemble des cellules à partir de la ligne 20 et aussi conserver les fonctionnalités de ce code, sachant que ce code concerne uniquement la cellule C4.
Y a-t-il une solution?

Merci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$4" Then h = Sheets("Repertoire SEDAM tempo").Range("Auteur").Value Me.ComboBoxChoixAuteur.List = h Me.ComboBoxChoixAuteur.Height = Target.Height + 3 Me.ComboBoxChoixAuteur.Width = Target.Width Me.ComboBoxChoixAuteur.Top = Target.Top Me.ComboBoxChoixAuteur.Left = Target.Left Me.ComboBoxChoixAuteur = Target Me.ComboBoxChoixAuteur.Visible = True Me.ComboBoxChoixAuteur.Activate Else Me.ComboBoxChoixAuteur.Visible = False Call RemplissageInterlocuteur End If

Citation:

sachant que ce code concerne uniquement la cellule C4.

non
Code:

1 2 3 4 5 6 7 8 9 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$4" Then Else Me.ComboBoxChoixAuteur.Visible = False Call RemplissageInterlocuteur End If
Si tu n'est pas en C4 ce code lance la macro "RemplissageInterlocuteur"

Bien vu, merci,

J'ai corrigé comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Target.Address = "$C$4" Then
 
    h = Sheets("Repertoire SEDAM tempo").Range("Auteur").Value
    Me.ComboBoxChoixAuteur.List = h
    Me.ComboBoxChoixAuteur.Height = Target.Height + 3
    Me.ComboBoxChoixAuteur.Width = Target.Width
    Me.ComboBoxChoixAuteur.Top = Target.Top
    Me.ComboBoxChoixAuteur.Left = Target.Left
    Me.ComboBoxChoixAuteur = Target
    Me.ComboBoxChoixAuteur.Visible = True
    Me.ComboBoxChoixAuteur.Activate
  Else
    Me.ComboBoxChoixAuteur.Visible = False
 
 End If
 
If Target.Address <> "$B$20:$I$100" Then
    Call RemplissageInterlocuteur
 
End If

Problème, dans la suite de mon code.
Il permet la mise en forme des cellules destinataires du ( Ctral+V).

Code:

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
'+++++++++++++++++++++++++++++++++++++++++++++++Mise en forme+++++++++++++++++++++++++++++++++
 
 Dim I As Integer
For I = 0 To 50 'compteur de 0 à 50 (pour toutes les lignes de 0 à 50)
 
 
If Range("B20").Offset(I).Value <> "" Or Range("C20").Offset(I).Value <> "" Then 'si à partir de B20 x compteur valeur non vide alors
    'CommandButtonGo.Visible = True 'Bouton GO visible
    Range("A20").Offset(I).Value = 1 + (I) 'Ajout n° de ligne +1
    Range("A20:E20").Offset(I).Borders.Value = 1 ' Ajout des bordures des lignes non vides
    End If
 
 
If Range("B20").Offset(I).Value = "" And Range("C20").Offset(I).Value = "" Then ' Si colonne B et C side, alors
    Range("A20").Offset(I).Value = ""   'Suppression du n° de ligne
    Range("A20:E20").Offset(I).Borders.Value = 0    'Suppression des bordures
    End If
 
If Range("F20").Offset(I).Value <> "" Then 'Colonne quantité
    Range("F20").Offset(I).Value = CDbl(Range("F20").Offset(I).Value)
    Range("F20").Offset(I).Borders.Value = 1
    End If
 
If Range("F20").Offset(I).Value = "" Then
    Range("F20").Offset(I).Borders.Value = 0
    End If
 
If Range("G20").Offset(I).Value <> "" Then
    Range("G20").Offset(I).Borders.Value = 1
    End If
 
If Range("G20").Offset(I).Value = "" Then
    Range("G20").Offset(I).Borders.Value = 0
    End If
 
If Range("H20").Offset(I).Value <> "" Then
    Range("H20").Offset(I).NumberFormat = "#,##0.00 $" 'Mise en forme PU
    Range("H20").Offset(I).Value = CDbl(Range("H20").Offset(I).Value)
    Range("H20:I20").Offset(I).Borders.Value = 1
    Range("I20").Offset(I).Value = Range("F20").Offset(I).Value * Range("H20").Offset(I).Value 'PT = Qté x PU
    Range("I20").Offset(I).NumberFormat = "#,##0.00 $" 'Mise en forme PT
    End If
 
If Range("H20").Offset(I).Value = "" Then
    Range("H20:I20").Offset(I).Borders.Value = 0
    Range("I20").Offset(I).Value = ""
    End If
 
Next
 
 
 'Call Doublons
 
 
 
 
End Sub

Y a-t-il une solution pour ce cas?

Merci

17/08/2016, 11h16
halaster08

Désolé, mais je n'ai pas compris quel est le problème.
17/08/2016, 11h26
Walt51

Je cherche à pouvoir faire des copier-coller dans ma feuille depuis un autre feuille ou un autre fichier. Et coller les éléments sur une plage de la ligne 20 à 100.
Quand je clic par exemple en B20 pour faire un (Ctrl+V) la macro de "mise en forme" se lance. Et du coup ce que j'avais "mis en mémoire" lors du (Ctrl+C) est perdu.
17/08/2016, 11h31
halaster08

Dans ce cas il faudrait peut être changer l'évènement qui fait la mise en forme, as tu vraiment besoin de le faire a chaque selection?
(voir le tuto pour la liste des evenements)
17/08/2016, 12h25
Walt51

Super le tuto, mais je n'ais pas trouvé d’événement qui convient à mon utilisation.
Je vais créer un bouton "mise en forme" et ça ira très bien.

J'ai trouvé une solution,
J'ai remplacé l'instruction

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

par

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Du coup les lignes de mon tableau s'affichent dès que les valeurs sont changé et non plus quand une cellule est sectionnée.

Mais un nouveau problème survient pour l'exemple suivant

Code:

1
2
3
4
If Range("H20").Offset(I).Value = "" Then 'Si PU vide alors
    Range("H20:I20").Offset(I).Borders.Value = 0 'Supprimer les bordures PU et PT
'    Range("I20").Offset(I).Value = "" 'Supprimer le PT
    End If

En effet je pense que le serpent se mord la queue quand ma macro vient supprimer la valeur en I

Y a-t-il une solution?

Merci

Voici mon code complet:(j'ai mis" ' " devant les lignes problématiques)

Code:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
'Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Ligne remplacé par Private Sub Worksheet_Change(ByVal Target As Range)
 
 
 
    'permet de sortir de la procédure si plus d'une cellule est sélectionnée
    '(sinon la suite de la macro renvoie un message d'erreur)
    If Target.Count > 1 Then Exit Sub
 
 
  Dim I As Integer
 
 
If Not Application.Intersect(Target, Range("B20:I100")) Is Nothing Then 'si pas de changement de valeur dans les cellules B20 à I100 => rien , sinon
 
 
For I = 0 To 50 'compteur de 0 à 50 (pour toutes les lignes de 0 à 50)
 
If Range("B20").Offset(I).Value <> "" Or Range("C20").Offset(I).Value <> "" Then 'si à partir de B20 x compteur valeur non vide alors
    'CommandButtonGo.Visible = True 'Bouton GO visible
    Range("A20").Offset(I).Value = 1 + (I) 'Ajout n° de ligne +1
    Range("A20:E20").Offset(I).Borders.Value = 1 ' Ajout des bordures des lignes non vides
    End If
 
 
If Range("B20").Offset(I).Value = "" And Range("C20").Offset(I).Value = "" Then ' Si colonne B et C side, alors
    Range("A20").Offset(I).Value = ""   'Suppression du n° de ligne
    Range("A20:E20").Offset(I).Borders.Value = 0    'Suppression des bordures
    End If
 
 
If Range("F20").Offset(I).Value <> "" Then 'Si QTE non vide alors
'    Range("F20").Offset(I).Value = CDbl(Range("F20").Offset(I).Value)
    Range("F20").Offset(I).Borders.Value = 1 'mettre les bordures
    End If
 
If Range("F20").Offset(I).Value = "" Then 'Si QTE vide alors
    Range("F20").Offset(I).Borders.Value = 0 'Supprimer les bordures
    End If
 
If Range("G20").Offset(I).Value <> "" Then 'Colonne unité
    Range("G20").Offset(I).Borders.Value = 1
    End If
 
If Range("G20").Offset(I).Value = "" Then 'Colonne unité
    Range("G20").Offset(I).Borders.Value = 0
    End If
 
If Range("H20").Offset(I).Value <> "" Then 'Si PU non vide alors
'    Range("H20").Offset(I).NumberFormat = "#,##0.00 $" 'Mise en forme PU
'    Range("H20").Offset(I).Value = CDbl(Range("H20").Offset(I).Value)
    Range("H20:I20").Offset(I).Borders.Value = 1
'    Range("I20").Offset(I).Value = Range("F20").Offset(I).Value * Range("H20").Offset(I).Value 'PT = Qté x PU
'    Range("I20").Offset(I).NumberFormat = "#,##0.00 $" 'Mise en forme PT
    End If
 
If Range("H20").Offset(I).Value = "" Then 'Si PU vide alors
    Range("H20:I20").Offset(I).Borders.Value = 0 'Supprimer les bordures PU et PT
'    Range("I20").Offset(I).Value = "" 'Supprimer le PT
    End If
 
Next
 
End If
 
End Sub

17/08/2016, 16h12
halaster08

Tu peux désactiver les évènements pendant ta macro via l'instruction

Code:

application.enableevents = false

A remettre a true quand tu as fini.
17/08/2016, 16h22
Walt51

Super,

Merci beaucoup:lol: