RDV+DIAL chat illimit� dans ta r�g!
no save
Assistance
Achat
News

Forum | programmation
Excel - macro (mise en forme conditionnelle)
chewi, le jeu. 31 août 2006 à 22:43:11
Bonjour au forum,

Voilà mon mon problème:

J'ai créé une macro qui transfère des données d'une feuille à une autre à des endroits variant suivant la valeur d'une cellule. ( 4 possibilités : AV,RV,RP et AP )

Je mets ensuite en format conditionnel (verte ou rouge) une des cellules transférées (moyenne de 3 autres).

Dans les cas RV et RP, aucun problème.
Mais dans les cas AV et AP, il m'affiche le message d'erreur suivant pour les lignes commençant par .FormatConditions.Add (If "AV" ou If "AP" suivant le cas) :

Run-time error '1004':
Application-defined or object-defined error

(Pour info, hier, jour de la création de la macro, tout allait bien)

Quelqu'un peut-il m'éclairer sur ce qui ne va pas?
Sachant que je suis assez novice en VBA.

D'avance merci.

Voici la macro:

Sub DataExportFr()

Dim Colonne As Byte
Dim trouve

With Sheets("Feuil1")

If UCase(Left(.Range("I2"), 2)) = "AV" Then
Colonne = Feuil2.Range("IV14").End(xlToLeft).Column + 1
If Colonne < 4 Then Colonne = 4
.Range("J2:J4").Copy Feuil2.Cells(14, Colonne)
.Range("E2").Copy Feuil2.Cells(8, Colonne)
.Range("F2").Copy Feuil2.Cells(9, Colonne)
.Range("G2").Copy Feuil2.Cells(10, Colonne)
.Range("H2").Copy Feuil2.Cells(12, Colonne)
.Range("B2").Copy Feuil2.Cells(13, Colonne)
.Range("J5").Copy Feuil2.Cells(17, Colonne)

With Feuil2.Cells(17, Colonne)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="16", Formula2:="22"
.FormatConditions(1).Font.ColorIndex = 3

.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="16", Formula2:="22"
.FormatConditions(2).Font.ColorIndex = 10
End With

ElseIf UCase(Left(.Range("I2"), 2)) = "RV" Then
Colonne = Feuil2.Range("IV43").End(xlToLeft).Column + 1
If Colonne < 12 Then Colonne = 12
.Range("J2:J4").Copy Feuil2.Cells(43, Colonne)
.Range("E2").Copy Feuil2.Cells(39, Colonne)
.Range("H2").Copy Feuil2.Cells(40, Colonne)
.Range("B2").Copy Feuil2.Cells(41, Colonne)
.Range("J5").Copy Feuil2.Cells(46, Colonne)

With Feuil2.Cells(46, Colonne)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="16", Formula2:="22"
.FormatConditions(1).Font.ColorIndex = 3

.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="16", Formula2:="22"
.FormatConditions(2).Font.ColorIndex = 10
End With

ElseIf UCase(Left(.Range("I2"), 2)) = "RP" Then
Colonne = Feuil2.Range("IV43").End(xlToLeft).Column + 1
If Colonne < 12 Then Colonne = 12
.Range("J2:J4").Copy Feuil2.Cells(43, Colonne)
Feuil2.Cells(43, Colonne).Font.ColorIndex = 5
Feuil2.Cells(44, Colonne).Font.ColorIndex = 5
Feuil2.Cells(45, Colonne).Font.ColorIndex = 5

.Range("E2").Copy Feuil2.Cells(39, Colonne)
.Range("H2").Copy Feuil2.Cells(40, Colonne)
.Range("B2").Copy Feuil2.Cells(41, Colonne)

Feuil2.Cells(39, Colonne).Font.ColorIndex = 5
Feuil2.Cells(40, Colonne).Font.ColorIndex = 5
Feuil2.Cells(41, Colonne).Font.ColorIndex = 5

.Range("J5").Copy Feuil2.Cells(46, Colonne)

With Feuil2.Cells(46, Colonne)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="16", Formula2:="23"
.FormatConditions(1).Font.ColorIndex = 3

.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="16", Formula2:="23"
.FormatConditions(2).Font.ColorIndex = 10
End With

ElseIf UCase(Left(.Range("I2"), 2)) = "AP" Then
Set trouve = Feuil2.Range("D8:IV8").Find(.Range("E2"), LookIn:=xlValues)
If trouve Is Nothing Then
MsgBox ("Cette valeur n'existe pas!")
Exit Sub
End If
.Range("J2:J4").Copy Feuil2.Cells(21, trouve.Column)
.Range("J5").Copy Feuil2.Cells(24, trouve.Column)

With Feuil2.Cells(24, trouve.Column)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="16", Formula2:="23"
.FormatConditions(1).Font.ColorIndex = 3
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="16", Formula2:="23"
.FormatConditions(2).Font.ColorIndex = 10
End With

End If
Application.DisplayAlerts = False
Sheets("Feuil1").Select
Cells.ClearContents
Application.DisplayAlerts = True
Range("J5").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-3]C:R[-1]C)"
Sheets("Feuil2").Select

End With

End Sub Configuration: Excel 2000


Armojax
sept. 06
Suivant
REPONSES
Armojax
sept. 06
Chewi
sept. 06
Armojax
sept. 06
Chewi
sept. 06
Armojax
sept. 06
Chewi
sept. 06
Chewi
sept. 06
Armojax
sept. 06
Momo
mars 08
Version Web
Réalisé par RedShift
no save