traiter mcellule target

**pilounet54** · 12/05/2012, 18h49

bonjour j'ai ceci

Code :

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

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

Invité · 12/05/2012, 18h55

Salut Piloune54

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

A+

**pilounet54** · 12/05/2012, 19h15

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
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

Invité · 12/05/2012, 19h20

Re,

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

Code :

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

Sub traiter_cellule(pcellule As Range)

Ensuite le code devrait fonctionner de la sorte

A+

**pilounet54** · 12/05/2012, 20h35

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

Invité · 12/05/2012, 20h56

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 :

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

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+

traiter mcellule target [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager