Discussion :

[mimirak]

bonjour
je débute dans l'Excel et je suis un peu perdue
j'ai réussi à établir si on peut le dire des tableaux "pré-établis" pour la distribuer aux différents établissement afin de les remplir directement
mais j'ai beugué sur la feuille "complications et score"; je voudrai appliquer "la sélection multiple" dans les cellules des trois colonnes B (complications secondaires) C (complications tardives) et J (fonction), ça a marché pour une seule colonne mais j'arrive pas à la reproduire sur les deux autres et ça annule automatiquement ma première programmation (j'ai joint le fichier)

je vous remercie d'avance pour votre aide
please help me

Traumatisme du Coude - Copie.xlsm

[riaolle]

Bonjour et bienvenue au forum,
Peux-tu nous expliquer ton problème sans pieces jointes : cf. https://www.developpez.net/forums/d8...s-discussions/
Quelle est la formule en question (cf. titre) ? Quel est le lien avec VBA ?

[mimirak]

la formule que j'ai utilisé pour la sélection multiple dans la colonne J (fonction) est la suivante:

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
Private Sub Worksheet_Change(ByVal Target As Range)
'Développé par Contextures Inc.
'Www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo ExitHandler
 
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo ExitHandler
 
If rngDV Is Nothing Then GoTo ExitHandler
 
 
If Intersect(Target, rngDV) Is Nothing Then
   'do nothing
Else
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column = 10 Then
    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
      Target.Value = oldVal _
        & "," & newVal
'REMARQUE: vous pouvez utiliser une ligne de rupture,
'Au lieu d'une virgule
'Target.Value = oldVal _
'& Chr (10) & newVal
      End If
    End If
  End If
End If
 
ExitHandler:
  Application.EnableEvents = True
End Sub

mais pour reproduire la même fonction dans les colonnes B et C sur la même feuille ça ne marche pas
qu'est ce que je doit faire ????

[mimirak]

et merci pour votre interet Riaolle, et excusez mon expression pour le titre (je savais pas comment exposer mon problème)

[riaolle]

ça a marché pour une seule colonne

Je suis étonnée que ton code "marche", qu'il permette de concaténer des valeurs...mais si tu le dis ...

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
Private Sub Worksheet_Change(ByVal Target As Range)
 'Développé par Contextures Inc.
 'Www.contextures.com
 Dim rngDV As Range
 Dim oldVal As String
 Dim newVal As String
 If Target.Count > 1 Then GoTo ExitHandler

 On Error Resume Next
 Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
 On Error GoTo ExitHandler

 If rngDV Is Nothing Then GoTo ExitHandler


 If Intersect(Target, rngDV) Is Nothing Then
 'do nothing
 Else
 Application.EnableEvents = False
 newVal = Target.Value
 Application.Undo
 oldVal = Target.Value
 Target.Value = newVal
 If Target.Column = 10 Then
 If oldVal = "" Then
 'do nothing
 Else
 If newVal = "" Then
 'do nothing
 Else
 Target.Value = oldVal _
 & "," & newVal
 'REMARQUE: vous pouvez utiliser une ligne de rupture,
 'Au lieu d'une virgule
 'Target.Value = oldVal _
 '& Chr (10) & newVal
 End If
 End If
 End If
 End If

 ExitHandler:
 Application.EnableEvents = True
 End Sub

En rouge, tu mets la condition : si la colonne est la colonne n° 10 (la colonne J). Il suffit d'élargir la condition pour d'autres colonnes.
D'autre part :

Code :

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

1
2
3
4
5
 If Intersect(Target, rngDV) Is Nothing Then
 'do nothing
 Else
...
End If

Equivaut à :

Code :

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

1
2
3
 If Not Intersect(Target, rngDV) Is Nothing Then
 ...
End If

Code :

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

1
2
3
4
5
6
7
8
 If oldVal = "" Then
 'do nothing
 Else
 If newVal = "" Then
 'do nothing
 Else
...
End If

Equivaut à

Code :

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

1
2
3
 If oldVal <> "" And  newVal <> "" Then
...
End If

[riaolle]

https://msdn.microsoft.com/fr-fr/lib.../ff838189.aspx

Application.Undo
Cette méthode n'annule que la dernière opération commandée par l'utilisateur avant l'exécution de la macro et doit figurer en première ligne dans la macro.

[mimirak]

le code fonctionne maintenant je vous remercie beaucoup mais j'ai pas compris comment l'élargir au deux autres colonnes B et C

[riaolle]

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
Private Sub Worksheet_Change(ByVal Target As Range)
 'Développé par Contextures Inc.
 'Www.contextures.com
 Dim rngDV As Range
 Dim oldVal As String
 Dim newVal As String
 If Target.Count > 1 Then GoTo ExitHandler
 On Error Resume Next
 Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
 On Error GoTo ExitHandler
 If rngDV Is Nothing Then GoTo ExitHandler
 If Intersect(Target, rngDV) Is Nothing Then
...
 If Target.Column = 10 Then
...
 End If
 End If
 End If
 End If

 ExitHandler:
 Application.EnableEvents = True
 End Sub

En rouge, tu mets la condition : si la colonne est la colonne n° 10 (la colonne J). Il suffit d'élargir la condition pour d'autres colonnes.

Tu dis "si la colonne de la cellule cible est la colonne n° 10 (donc la colonne J), alors j'effectue les operations". Or toi, tu veux, "si la colonne de la cellule cible est la colonne n° 10 ou la colonne n°2 ou la colonne n° 3, alors j'effectue les operations".
Exemple d'utilisation de Or (ou) qui peut t'aider :

Code :

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

1
2
3
Sub test()
    If Range("A1").Value = 1 Or Range("A1").Value = 2 Then MsgBox "coucou"
End Sub

[mimirak]

merciiiiii beaucoup Riaolle
ça marche