Dans cette macro,
- faire la somme dans "BE" de "BD"
- et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne
fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is
Nothing And Target.Count = 1 Then
If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40
'Selection.Font.ColorIndex = 3
Target.Font.ColorIndex = 3
Else
Const iMin As Long = 17 'A ajuster
Const iMax As Long = 169 'A ajuster
Const iCol As Long = 57 'A ajuster
Dim Rg As Range
Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne
BD
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each c In Rg
If c <> "" Then
If IsNumeric(c) Then
If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _
c.Offset(, -1).Value Then
MsgBox "Le montant est supérieur à vos disponibilités."
c.Select
Application.EnableEvents = True
Set Rg1 = Target
Exit Sub
Else
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
End If
Else
c.Value = ""
End If
End If
Next
Set Rg1 = Target
Application.EnableEvents = True
Else
Set Rg = Nothing
End If
End If
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
FdeCourt
Bonsoir Erico,
Qu'est ce qui ne marche pas ?
Bonjour a tous,
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colo nne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibil ités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Val ue End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub
Bonsoir Erico,
Qu'est ce qui ne marche pas ?
Bonjour a tous,
Dans cette macro,
- faire la somme dans "BE" de "BD"
- et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne
fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is
Nothing And Target.Count = 1 Then
If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40
'Selection.Font.ColorIndex = 3
Target.Font.ColorIndex = 3
Else
Const iMin As Long = 17 'A ajuster
Const iMax As Long = 169 'A ajuster
Const iCol As Long = 57 'A ajuster
Dim Rg As Range
Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colo nne
BD
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each c In Rg
If c <> "" Then
If IsNumeric(c) Then
If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _
c.Offset(, -1).Value Then
MsgBox "Le montant est supérieur à vos disponibil ités."
c.Select
Application.EnableEvents = True
Set Rg1 = Target
Exit Sub
Else
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Val ue
End If
Else
c.Value = ""
End If
End If
Next
Set Rg1 = Target
Application.EnableEvents = True
Else
Set Rg = Nothing
End If
End If
End Sub
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colo nne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibil ités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Val ue End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub
Érico
La sommation qui se fait dans la collonne "BE" a chaque fois que je rentre un chifffre dans "BD"
"FdeCourt" a écrit dans le message de news:
Bonsoir Erico,
Qu'est ce qui ne marche pas ?
Bonjour a tous,
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibilités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub
La sommation qui se fait dans la collonne "BE" a chaque fois que je rentre
un chifffre dans "BD"
"FdeCourt" <fdecourt@gmail.com> a écrit dans le message de news:
1167852786.170644.227490@v33g2000cwv.googlegroups.com...
Bonsoir Erico,
Qu'est ce qui ne marche pas ?
Bonjour a tous,
Dans cette macro,
- faire la somme dans "BE" de "BD"
- et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne
fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is
Nothing And Target.Count = 1 Then
If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40
'Selection.Font.ColorIndex = 3
Target.Font.ColorIndex = 3
Else
Const iMin As Long = 17 'A ajuster
Const iMax As Long = 169 'A ajuster
Const iCol As Long = 57 'A ajuster
Dim Rg As Range
Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne
BD
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each c In Rg
If c <> "" Then
If IsNumeric(c) Then
If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value +
_
c.Offset(, -1).Value Then
MsgBox "Le montant est supérieur à vos
disponibilités."
c.Select
Application.EnableEvents = True
Set Rg1 = Target
Exit Sub
Else
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
End If
Else
c.Value = ""
End If
End If
Next
Set Rg1 = Target
Application.EnableEvents = True
Else
Set Rg = Nothing
End If
End If
End Sub
La sommation qui se fait dans la collonne "BE" a chaque fois que je rentre un chifffre dans "BD"
"FdeCourt" a écrit dans le message de news:
Bonsoir Erico,
Qu'est ce qui ne marche pas ?
Bonjour a tous,
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibilités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub
Érico
Je vais essayer de mettre tous mes variables à "reset", comment je fais?
"Érico" a écrit dans le message de news:
Bonjour a tous,
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibilités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub
Je vais essayer de mettre tous mes variables à "reset", comment je fais?
"Érico" <hahaha@videotron.ca> a écrit dans le message de news:
u8HqXR1LHHA.4196@TK2MSFTNGP03.phx.gbl...
Bonjour a tous,
Dans cette macro,
- faire la somme dans "BE" de "BD"
- et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne
fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)
' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is
Nothing And Target.Count = 1 Then
If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40
'Selection.Font.ColorIndex = 3
Target.Font.ColorIndex = 3
Else
Const iMin As Long = 17 'A ajuster
Const iMax As Long = 169 'A ajuster
Const iCol As Long = 57 'A ajuster
Dim Rg As Range
Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne
BD
If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each c In Rg
If c <> "" Then
If IsNumeric(c) Then
If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _
c.Offset(, -1).Value Then
MsgBox "Le montant est supérieur à vos disponibilités."
c.Select
Application.EnableEvents = True
Set Rg1 = Target
Exit Sub
Else
c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value
End If
Else
c.Value = ""
End If
End If
Next
Set Rg1 = Target
Application.EnableEvents = True
Else
Set Rg = Nothing
End If
End If
End Sub
Je vais essayer de mettre tous mes variables à "reset", comment je fais?
"Érico" a écrit dans le message de news:
Bonjour a tous,
Dans cette macro, - faire la somme dans "BE" de "BD" - et de mettre en rouges , tous les chagements de données.
Depuis que j'ai rajouter la fonction de mettre en rouge, ma sommation ne fonctionne pas.
Pourquoi?
Merci à l'avance de votre aide
________________________________________________________ Private Sub Worksheet_Change(ByVal Target As Range) ' If Not Intersect([A17:AO70,A76:AO101,A106:AO126,B132:AO152], Target) Is Nothing And Target.Count = 1 Then If Target.Count = 1 Then
'Target.Interior.ColorIndex = 40 'Selection.Font.ColorIndex = 3 Target.Font.ColorIndex = 3 Else Const iMin As Long = 17 'A ajuster Const iMax As Long = 169 'A ajuster Const iCol As Long = 57 'A ajuster
Dim Rg As Range Set Rg = Intersect(Target, Range("BD" & iMin & ":BD" & iMax)) 'colonne BD
If Not Rg Is Nothing Then Application.EnableEvents = False For Each c In Rg If c <> "" Then If IsNumeric(c) Then If c.Offset(, 1).Value + c.Value > c.Offset(, -2).Value + _ c.Offset(, -1).Value Then MsgBox "Le montant est supérieur à vos disponibilités." c.Select Application.EnableEvents = True Set Rg1 = Target Exit Sub Else c.Offset(0, 1).Value = c.Offset(0, 1).Value + c.Value End If Else c.Value = "" End If End If Next Set Rg1 = Target Application.EnableEvents = True Else Set Rg = Nothing End If End If End Sub