Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Erreur dans la Macro

Erreur dans la Macro

3 réponses
Avatar
Érico
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
Signaler un problème avec ce contenu

3 réponses

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


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


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