[XL-2010] traiter mcellule target

traiter mcellule target

bonjour j'ai ceci

Code:

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change(ByVal Target As Range) 
 Dim mCellule As Object
    'If autorise_traitement = True Then
     For Each mCellule In Target
            If mCellule.Column = 3 Then
                traiter_cellule mCellule
            End If
        Next mCellule
    'End If
End Sub

mais ,si je colle des données cela ne traite pas les mcellule comment je peus faire svp

Salut Piloune54

Quand tu dis que ça ne traite pas tes cellules !?
Quel le code entier de ta sub "Traiter_cellule" ?

A+

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
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
109
110
111
112
113
114
115
116
117
118
Sub traiter_cellule(pcellule As Variant)
  If pcellule.Value = "" Then
 
              '''''''''''''''''''''''''''''''''''efface value'''''''''''''''''''''''''''''
 
 
             With Range(Cells(pcellule.Row, pcellule.Column + 1), Cells(pcellule.Row, pcellule.Column + 14)).Cells
                 .Value = ""
            End With
 
             '''''''''''''''''''''''''''''''''''efface couleur'''''''''''''''''''''''''''''
             With Range(Cells(pcellule.Row, pcellule.Column + 6), Cells(pcellule.Row, pcellule.Column + 12)).Interior
                .ColorIndex = 0
                .Pattern = xlSolid
             End With
 
            '''''''''''''''''''''''''''''''''''''efface la bordure''''''''''''''''''''''''''
             With Range(Cells(pcellule.Row, pcellule.Column + 0), Cells(pcellule.Row, pcellule.Column + 14)).Borders
 
 
                .LineStyle = xlNone
                ''.Weight = xlThin
                '.ColorIndex = 0
             End With
 
       Else
 
 
 
 
            ''''''''''''''''''''''''''''''=SI(C8<>"";M7+K8;"")''''''''''''''''''''''''''''''
            pcellule.Offset(0, 10).FormulaLocal = "=SI(C" & pcellule.Row & "<>"""";M" & pcellule.Row - 1 & "+K" & pcellule.Row & ";" & """"")"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            ''''''''''''''''''''''''''''''=SI(C8<>"";N7+L8;"")''''''''''''''''''''''''''''''
            pcellule.Offset(0, 11).FormulaLocal = "=SI(C" & pcellule.Row & "<>"""";N" & pcellule.Row - 1 & "+L" & pcellule.Row & ";" & """"")"
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            ''''''''''''''''''''''''''''''=M8+N8''''''''''''''''''''''''''''''''''''''''''
            pcellule.Offset(0, 12).FormulaLocal = "=SI(C" & pcellule.Row & "<>"""";M" & pcellule.Row & "+N" & pcellule.Row & ";" & """"")"
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            '''''''''''''' =SI(I8="";"";SI(K8+L8<I8;"inférieur";SI(K8+L8>I8;"supérieur";SI(K8+L8=I8;"ok"))))''''''''''''''''
 
            pcellule.Offset(0, 13).FormulaLocal = "=SI(I" & pcellule.Row & "="""";"""";SI(K" & pcellule.Row & "+L" & pcellule.Row & "<I" & pcellule.Row & ";""inférieur"";SI(K" & pcellule.Row & "+L" & pcellule.Row & ">I" & pcellule.Row & ";""supérieur"";SI(K" & pcellule.Row & "+L" & pcellule.Row & "=I" & pcellule.Row & ";""ok""))))"
 
 
            '''''''''''''=SI(J8="";"";SI(L8+K8<J8;"inférieur";SI(L8+K8>J8;"supérieur";SI(L8+K8=J8;"ok"))))''''''''''''''''''
 
            pcellule.Offset(0, 14).FormulaLocal = "=SI(J" & pcellule.Row & "="""";"""";SI(L" & pcellule.Row & "+K" & pcellule.Row & "<J" & pcellule.Row & ";""supérieur"";SI(L" & pcellule.Row & "+K" & pcellule.Row & ">J" & pcellule.Row & ";""inférieur"";SI(L" & pcellule.Row & "+K" & pcellule.Row & "=J" & pcellule.Row & ";""ok""))))"
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
    ''''couleur jaune
 
            ' With  pCellule.Offset(0, 10).Interior
             With Range(Cells(pcellule.Row, pcellule.Column + 10), Cells(pcellule.Row, pcellule.Column + 12)).Interior
 
                .ColorIndex = 6
                .Pattern = xlSolid
             End With
 
             With Range(Cells(pcellule.Row, pcellule.Column + 0), Cells(pcellule.Row, pcellule.Column + 14)).Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 1
             End With
 
   ''''couleur vert
 
               If pcellule.Value = "" Then
                   With pcellule.Offset(0, 6).Interior
                       .ColorIndex = 0
                       .Pattern = xlSolid
                   End With
                Else
                   With pcellule.Offset(0, 6).Interior
                       .ColorIndex = 35
                       .Pattern = xlSolid
                   End With
               End If
    ''''couleur rose
              If pcellule.Value = "" Then
                   With pcellule.Offset(0, 7).Interior
                       .ColorIndex = 0
                       .Pattern = xlSolid
                   End With
                Else
                   With pcellule.Offset(0, 7).Interior
                       .ColorIndex = 38
                       .Pattern = xlSolid
                   End With
               End If
 
 
 
 
'''''''''''''''''''''''''''''''''''''''''''''colonne en automatique
 
               ' If ActiveWorkbook Is Nothing Then Exit Sub
                   ' Dim i
                     'If ActiveWindow.SelectedSheets.Count > 1 Then
                        'For i = 1 To ActiveWindow.SelectedSheets.Count
                                   ' ActiveWindow.SelectedSheets(i).Cells.EntireColumn.AutoFit
                        'Next
                                'Else
                                    'Cells.EntireColumn.AutoFit
                     'End If
                'End If
 
  End If
 'End If
End Sub

Re,

Il faudrait déjà changer la déclaration de ta sub

Code:

Sub traiter_cellule(pcellule As Range)

Ensuite le code devrait fonctionner de la sorte ;)

A+

le probléme

le probleme c'est que comme j'ai des colonnes protegées je suis oblige de coler les donnees en mode creation et meme avec la modification que j'ai apporté cela ne fontionne pas

Re,

Ahhh mais tu ne nous dis pas tout :?

Il faut donc déprotéger la feuille avant d'appliquer les modifs
Essaye ça ;)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range) 
 Dim mCellule As Object
    'If autorise_traitement = True Then
    ActiveSheet.Unprotect
     For Each mCellule In Target
            If mCellule.Column = 3 Then
                traiter_cellule mCellule
            End If
        Next mCellule
    ActiveSheet.Protect
    'End If
End Sub

A+

formule

j'ai bien essaye, mais proteger la feuille pour l'instant ne me convient pas car cela me genère des problemes ailleur ..;et cela fonctionne pas car je n'ai pas la selection
merci pour le coup de main es que lon pourrai /exemple si cellule <>""= traiter cellule
sans que le target rentre en jeu ? je pense que cela pourrai fonctionné es que ou autre idée es que l'on pourrai sur entree du clavier en colonne 3 = traiter cellule
vous pourvez m'aider ?