erreur sur elaboration d un code

Le
ALF
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de "Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et bloque a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-->RANGE(c.Offset(0, 1), c.Offset(0, 2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JP25
Le #4550691
Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de "Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0, 2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF


ALF
Le #4546281
Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF



Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de "Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0, 2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) = "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c, 13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF







JP25
Le #4546171
Bonjour ALF
La méthode Union devrait correspondre
Je regarderai dans la journée si possible
Bonne journée
JP25
"ALF"
Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF



Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF









JP25
Le #4546151
Re ALF
j'ai testé un petit bout de code avec union, a adapter

Sub b()

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet

For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Set tab1 = Range(c.Offset(0, 1), c.Offset(0, 2))
Set tab2 = Range(c.Offset(0, 4), c.Offset(0, 5))
Set maSélectionMultiple = Union(tab1, tab2)
maSélectionMultiple.Select

'Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
Exit Sub

A+
JP25

"ALF"
Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF



Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF









JLuc
Le #4546121
*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle
seulement sur la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la
même boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")


--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O

JLuc
Le #4546081
Voici le code obtenu :-) : plus simple à maintenir et on voit mieux ce
que l'on fait, moins long car moins de boucles

Dim FeuilleActive As Worksheet
Dim Couleur As Variant
Dim Motif As Long
Dim CouleurMotif As Long
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:B73")
Select Case c
Case "Taux de siren"
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Is = "Départs ACT"
Union(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de dossiers par ETP", "Nombre de d 'avis par ETP"
Union(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Montant du Stock", "Montant Moyen Créance", "Nombre Total de
dossiers en stock"
Union(c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Efficacité du recouvrement (sans ACI)", "Nombre d' ACI",
"Montant d' ACI"
c.Offset(0, 5).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de prestataires"
Union(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Else
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = xlNone
End Select
With Range(c.AddressLocal & ":" & c.Offset(0,
5).AddressLocal).Interior
.ColorIndex = xlAutomatic
.Pattern = xlPatternNone
.PatternColorIndex = xlColorIndexNone
End With
With Selection.Interior
.ColorIndex = Couleur
.Pattern = Motif
.PatternColorIndex = CouleurMotif
End With

Next c
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True


Dis nous ce que tu en pense
;-)
*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement sur
la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")



--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O


ALF
Le #4544531
bonsoir jean luc,

et merci pour ton info..en effet cela semble interressant..
par contre,je comprends pas trop pourquoi utiliser seulement la colonne
B,etant donné que des cellules peuvent se trouver ailleurs que sur la colonne
B???

d'autre part,j'ai un probleme pour Case Else Couleur=xlNone car certaines
cellules ont des motifs d'origine avec couleur...
existe t il dans ce cas Couleur = si Case est different de ceux declarés
alors laisser le motif d'origine...

et enfin,dans le code que m'avais propose jp25 ,la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...

merci pour ton soutien
--
ALF



Voici le code obtenu :-) : plus simple à maintenir et on voit mieux ce
que l'on fait, moins long car moins de boucles

Dim FeuilleActive As Worksheet
Dim Couleur As Variant
Dim Motif As Long
Dim CouleurMotif As Long
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:B73")
Select Case c
Case "Taux de siren"
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Is = "Départs ACT"
Union(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de dossiers par ETP", "Nombre de d 'avis par ETP"
Union(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Montant du Stock", "Montant Moyen Créance", "Nombre Total de
dossiers en stock"
Union(c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Efficacité du recouvrement (sans ACI)", "Nombre d' ACI",
"Montant d' ACI"
c.Offset(0, 5).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de prestataires"
Union(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Else
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = xlNone
End Select
With Range(c.AddressLocal & ":" & c.Offset(0,
5).AddressLocal).Interior
.ColorIndex = xlAutomatic
.Pattern = xlPatternNone
.PatternColorIndex = xlColorIndexNone
End With
With Selection.Interior
.ColorIndex = Couleur
.Pattern = Motif
.PatternColorIndex = CouleurMotif
End With

Next c
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True


Dis nous ce que tu en pense
;-)
*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement sur
la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")



--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O







ALF
Le #4544521
bonsoir jp25,

j'ai un probleme avec le code que tu m'a proposé car la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...
apparemment,Le code ne reconnait pas MaSelectionMultiple..
a quoi cela est il du, faut il rajouter un element de la bibilotheque dans
outilreferences ???

merci pour ton soutien

--
ALF



Re ALF
j'ai testé un petit bout de code avec union, a adapter

Sub b()

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet

For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Set tab1 = Range(c.Offset(0, 1), c.Offset(0, 2))
Set tab2 = Range(c.Offset(0, 4), c.Offset(0, 5))
Set maSélectionMultiple = Union(tab1, tab2)
maSélectionMultiple.Select

'Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
Exit Sub

A+
JP25

"ALF"
Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que 2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF



Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) =
"Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF














JP25
Le #4544511
Bonsoir ALF,
Je pense que tu dois avoir option explicit en début de module !
Tu fais dim MaSelectionMultiple as object au début de ta sub
Tu peux remplacer MaselctionMultilple par un autre nom !
Espère que ce sera bon
A ton service
JP

"ALF"
bonsoir jp25,

j'ai un probleme avec le code que tu m'a proposé car la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...
apparemment,Le code ne reconnait pas MaSelectionMultiple..
a quoi cela est il du, faut il rajouter un element de la bibilotheque
dans
outilreferences ???

merci pour ton soutien

--
ALF



Re ALF
j'ai testé un petit bout de code avec union, a adapter

Sub b()

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet

For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Set tab1 = Range(c.Offset(0, 1), c.Offset(0, 2))
Set tab2 = Range(c.Offset(0, 4), c.Offset(0, 5))
Set maSélectionMultiple = Union(tab1, tab2)
maSélectionMultiple.Select

'Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
Exit Sub

A+
JP25

"ALF"
Re,
et merci jp25 pour ta reponse..
le but de ce code est de selectionner certaines cellules qui sont à
droite
de la cellule "Nom de l'indicateur",pour pouvoir les griser car ce sont
des
cellules qui n'auront jamais de valeurs..
c'est pourquoi,parfois il faut 3 ou 4 arguments à griser..
d'où le probleme car tu viens de me signaler qu'il ne peut y avoir que
2
arguments dans la fonction RANGE()...

y a t-il alors un autre moyen pour devier ce probleme ???

Merci encore pour votre soutien

--
ALF



Bonjour

le nb d'argument est maxi 2
Que souhaites tu en finalité
J'ai corrigé le nb d'arguments
Essaie ceci

Sub a()
Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) >> >> "Nombrede
d 'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
MoyenCréance" Or Left(c, 33) = "Nombre Total de dossiers en stock"
Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or
Left(c,
13)
_
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next

Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
End Sub

jp25

"ALF"
Bonjour,

j'obtiend ce message d'erreur : erreur de compilation:
nombre d'arguments incorrect ou affectation de propriété incorrecte

et sur le code, l' erreur se positionne sur RANGE( au niveau de
"Départs
ACT" Et Apparemment,le 1er FOR EACH sur("Taux de siren") a bien
passé..

Par contre sur le 2eme FOR EACH sur("Départs ACT") ne passe pas et
bloque
a
ce niveau la..

For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then

l'erreur se positionne ici-------->RANGE(c.Offset(0, 1), c.Offset(0,
2),
c.Offset(0, 4), c.Offset(0, 5)).Select
pouvez vous resoudre ce probleme..je vous laisse ci joint le code en
question.

Merci de votre soutien

Dim FeuilleActive As Worksheet
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:Q73")
If Left(c, 13) = "Taux de siren" Then
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 11) = "Départs ACT" Then
Range(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 26) = "Nombre de dossiers par ETP" Or Left(c, 24) >> >> > "Nombre
de d'avis par ETP" Then
Range(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 16) = "Montant du Stock" Or Left(c, 21) = "Montant
Moyen
Créance" Or Left(c, 33) = "Nombre Total de dossiers en stock" Then
Range(c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 37) = "Efficacité du recouvrement (sans ACI)" Or
Left(c,
13)
= "Nombre d' ACI" Or Left(c, 14) = "Montant d' ACI" Then
Range(c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
For Each c In Range("B2:Q73")
If Left(c, 22) = "Nombre de prestataires" Then
Range(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
End If
Next c
Next s
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True
--


--
ALF
















JLuc
Le #4544171
*Bonjour ALF*,

bonsoir jean luc,

et merci pour ton info..en effet cela semble interressant..
par contre,je comprends pas trop pourquoi utiliser seulement la colonne
B,etant donné que des cellules peuvent se trouver ailleurs que sur la colonne
B???
J'ai (lamentablement) supposé que ton tableau était structuré avec ces

infos en colonne B. Mais tu peux remettre la même plage qu'au début, à
savoir B2:Q73. De toute façon tu fais quand même 5 ou 6 boucles de
moins ;-)

d'autre part,j'ai un probleme pour Case Else Couleur=xlNone car certaines
cellules ont des motifs d'origine avec couleur...
J'ai mis un Case Else car dans ton code d'origine, si tu trouvais

l'info cherchée tu mettais une couleur, sinon tu mettais :
Range(c.Offset(0, 3), c.Offset(0, 4)).Select
Selection.Interior.ColorIndex = xlNone
et ceci à chaque fois
J'en ai conclu que ... :-)

existe t il dans ce cas Couleur = si Case est different de ceux declarés
alors laisser le motif d'origine...
Il suffit d'enlever le Case Else


et enfin,dans le code que m'avais propose jp25 ,la macro bloque sur
MaSelectionMultiple.select..avec le message :OBJET requis manquant...
Attention, si tu a copier une partie du code et réécrit une autre

partie, MaSelectionMultiple prend un accent : MaS*é*lectionMultiple

merci pour ton soutien
Ce fut un plaisir

--
ALF



Voici le code obtenu :-) : plus simple à maintenir et on voit mieux ce
que l'on fait, moins long car moins de boucles

Dim FeuilleActive As Worksheet
Dim Couleur As Variant
Dim Motif As Long
Dim CouleurMotif As Long
Application.ScreenUpdating = False
Set FeuilleActive = ActiveSheet
Dim c As Range
For Each c In Range("B2:B73")
Select Case c
Case "Taux de siren"
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Is = "Départs ACT"
Union(c.Offset(0, 1), c.Offset(0, 2), c.Offset(0, 4), c.Offset(0,
5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de dossiers par ETP", "Nombre de d 'avis par ETP"
Union(c.Offset(0, 1), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Montant du Stock", "Montant Moyen Créance", "Nombre Total de
dossiers en stock"
Union(c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Efficacité du recouvrement (sans ACI)", "Nombre d' ACI",
"Montant d' ACI"
c.Offset(0, 5).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case "Nombre de prestataires"
Union(c.Offset(0, 3), c.Offset(0, 4), c.Offset(0, 5)).Select
Couleur = 15
Motif = xlSolid
CouleurMotif = xlAutomatic
Case Else
Union(c.Offset(0, 3), c.Offset(0, 4)).Select
Couleur = xlNone
End Select
With Range(c.AddressLocal & ":" & c.Offset(0,
5).AddressLocal).Interior
.ColorIndex = xlAutomatic
.Pattern = xlPatternNone
.PatternColorIndex = xlColorIndexNone
End With
With Selection.Interior
.ColorIndex = Couleur
.Pattern = Motif
.PatternColorIndex = CouleurMotif
End With

Next c
Range("B2").Select
Application.EnableEvents = True
FeuilleActive.Select
Application.ScreenUpdating = True


Dis nous ce que tu en pense
;-)
*Bonjour ALF*,
Pour tes boucles, tu gagnerais en temps si tu faisais ta boucle seulement
sur la colonne B :
For Each c In Range("B2:B73")
En complement, je ferais plutot un select case pour tout faire dans la même
boucle au lieu d'en faire 6. 6 boucles= 6 fois plus long :/

For Each c In Range("B2:Q73")



--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O






--
____
( O | O )
--
_oooO_ JLuc _Oooo_

O-O




Publicité
Poster une réponse
Anonyme