Remplacer couleur à l' intérieur de chaîne de caractères

Salut,
Est ce que ceci conviendrai ?
Il faut adapter. La proc "Test" sert à quoi ? à tester :o)) :

Sub Couleur(Cellule As Range, _
AncienneCouleur As Integer, _
NouvelleCouleur As Integer)
Dim I As Integer
With Cellule
For I = 1 To .Characters.Count
If .Characters(I, 1).Font.ColorIndex = _
AncienneCouleur Then
.Characters(I, 1).Font.ColorIndex = _
NouvelleCouleur
End If
Next I
End With
Set Cellule = Nothing
End Sub

Sub Test()
'rouge en orange
Couleur Range("C2"), 3, 46
End Sub

Hervé.

<animal.vayayora@gmail.com> a écrit dans le message news:
1118164518.079629.109220@g44g2000cwa.googlegroups.com...
Bonsoir à tous,

Après de multiples recherches infructeuses, j'en viens à ouvrir ce
topic.

Dans une feuille de classeur Excel, j'ai du texte dans plusieurs
cellules.
Nous utilisons un code de couleur pour identifier ce qui est :
- 'modifié' : rouge
- 'supprimé': Orange
- 'précédement modifié' : bleu (modifs du précédent indice)

Car document est indicé, et change d'indice (nom de fichier) dès que
nous lui apportons des modifications. (Donc des changements de
couleurs)

Les couleurs peuvent s'appliquer à une cellule entière, mais aussi à
une partie de texte contenue dans une cellule. Et c'est là que je
bute.

Je cherche le moyen de remplacer, par VBA, la couleur ROUGE par BLEUE
dès que je change d'indice.
Tant qu'il s'agit d'une cellule entière, je sais trouver la couleur,
mais lorsqu'il s'agit de portion de texte : je sèche !

J'image qu'il y a de la méthode 'Characters', la-dessus, mais je ne
sais pas par quel bout m'y prendre.

Auriez-vous de quoi m'éclairer ?
Merci d'avance, et longue vie au MPFE!

bonjour,

pour detecter les couleurs dans une chaine p.e ici en cellule A1

Set c = Cells(1, 1)
For I = 1 To Len(c.Value)
MsgBox c.Characters(Start:=I, Length:=1).Font.ColorIndex
Next


A+

Bonsoir à tous,

Après de multiples recherches infructeuses, j'en viens à ouvrir ce
topic.

Dans une feuille de classeur Excel, j'ai du texte dans plusieurs
cellules.
Nous utilisons un code de couleur pour identifier ce qui est :
- 'modifié' : rouge
- 'supprimé': Orange
- 'précédement modifié' : bleu (modifs du précédent indice)

Car document est indicé, et change d'indice (nom de fichier) dès que
nous lui apportons des modifications. (Donc des changements de
couleurs)

Les couleurs peuvent s'appliquer à une cellule entière, mais aussi à
une partie de texte contenue dans une cellule. Et c'est là que je
bute.

Je cherche le moyen de remplacer, par VBA, la couleur ROUGE par BLEUE
dès que je change d'indice.
Tant qu'il s'agit d'une cellule entière, je sais trouver la couleur,
mais lorsqu'il s'agit de portion de texte : je sèche !

J'image qu'il y a de la méthode 'Characters', la-dessus, mais je ne
sais pas par quel bout m'y prendre.

Auriez-vous de quoi m'éclairer ?
Merci d'avance, et longue vie au MPFE!

Bonjour,

Sub zaza()
Dim c As Range
For Each c In Selection
For i= 1 To Len(c.Value)
If c.Characters(i, 1).Font.ColorIndex = 5 Then _
c.Characters(i, 1).Font.ColorIndex = 3
Next i
Next c
End Sub


ChrisV


<animal.vayayora@gmail.com> a écrit dans le message de news:
1118164518.079629.109220@g44g2000cwa.googlegroups.com...
Bonsoir à tous,

Après de multiples recherches infructeuses, j'en viens à ouvrir ce
topic.

Dans une feuille de classeur Excel, j'ai du texte dans plusieurs
cellules.
Nous utilisons un code de couleur pour identifier ce qui est :
- 'modifié' : rouge
- 'supprimé': Orange
- 'précédement modifié' : bleu (modifs du précédent indice)

Car document est indicé, et change d'indice (nom de fichier) dès que
nous lui apportons des modifications. (Donc des changements de
couleurs)

Les couleurs peuvent s'appliquer à une cellule entière, mais aussi à
une partie de texte contenue dans une cellule. Et c'est là que je
bute.

Je cherche le moyen de remplacer, par VBA, la couleur ROUGE par BLEUE
dès que je change d'indice.
Tant qu'il s'agit d'une cellule entière, je sais trouver la couleur,
mais lorsqu'il s'agit de portion de texte : je sèche !

J'image qu'il y a de la méthode 'Characters', la-dessus, mais je ne
sais pas par quel bout m'y prendre.

Auriez-vous de quoi m'éclairer ?
Merci d'avance, et longue vie au MPFE!

Un peu plus complet...

Sub zaza()
Dim c As Range
cMod = Application.InputBox(vbCrLf & "Indiquez la couleur à modifier:" _
& vbCrLf & "(rouge, orange ou bleu)", _
"Couleur à modifier...", , , , , , 2)
If cMod = False Then Exit Sub
Select Case cMod
Case "rouge": cMod = 3
Case "orange": cMod = 46
Case "bleu": cMod = 5
End Select
cRem = Application.InputBox(vbCrLf & "Indiquez nouvelle la couleur:" _
& vbCrLf & "(rouge, orange ou bleu)", _
"Couleur de remplacement...", , , , , , 2)
If cRem = False Then Exit Sub
Select Case cRem
Case "rouge": cRem = 3
Case "orange": cRem = 46
Case "bleu": cRem = 5
End Select
For Each c In Selection
For I = 1 To Len(c.Value)
If c.Characters(I, 1).Font.ColorIndex = cMod Then _
c.Characters(I, 1).Font.ColorIndex = cRem
Next I
Next c
End Sub


ChrisV


"ChrisV" <chrisve@wanadoo.fr> a écrit dans le message de news:
%23WGwPh5aFHA.3736@TK2MSFTNGP15.phx.gbl...

Bonjour,

Sub zaza()
Dim c As Range
For Each c In Selection
For i= 1 To Len(c.Value)
If c.Characters(i, 1).Font.ColorIndex = 5 Then _
c.Characters(i, 1).Font.ColorIndex = 3
Next i
Next c
End Sub


ChrisV


<animal.vayayora@gmail.com> a écrit dans le message de news:
1118164518.079629.109220@g44g2000cwa.googlegroups.com...
Bonsoir à tous,

Après de multiples recherches infructeuses, j'en viens à ouvrir ce
topic.

Dans une feuille de classeur Excel, j'ai du texte dans plusieurs
cellules.
Nous utilisons un code de couleur pour identifier ce qui est :
- 'modifié' : rouge
- 'supprimé': Orange
- 'précédement modifié' : bleu (modifs du précédent indice)

Car document est indicé, et change d'indice (nom de fichier) dès que
nous lui apportons des modifications. (Donc des changements de
couleurs)

Les couleurs peuvent s'appliquer à une cellule entière, mais aussi à
une partie de texte contenue dans une cellule. Et c'est là que je
bute.

Je cherche le moyen de remplacer, par VBA, la couleur ROUGE par BLEUE
dès que je change d'indice.
Tant qu'il s'agit d'une cellule entière, je sais trouver la couleur,
mais lorsqu'il s'agit de portion de texte : je sèche !

J'image qu'il y a de la méthode 'Characters', la-dessus, mais je ne
sais pas par quel bout m'y prendre.

Auriez-vous de quoi m'éclairer ?
Merci d'avance, et longue vie au MPFE!

Et bien, si avec tous ça je ne trouve pas mon bonheur !
Je teste, et je vous tiens au courant.

Merci encore, à tous.

Merci encore à tous : ça fonctionne impec !

J'ai fait mes aménagements, et voilou le résultat :

--~-----------------------------------------------------------------------~ --
Sub subColourUpdate(rngPlage As Range)

Dim I As Integer
Dim rngCell As Range
Dim dteHourStart As Date
Dim dteHourEnd As Date

Application.ScreenUpdating = False
dteHourStart = Timer

For Each rngCell In rngPlage.SpecialCells(xlCellTypeConstants)
rngCell.Activate
For I = 1 To Len(rngCell)
'RED becomes BLUE
If rngCell.Characters(I, 1).Font.ColorIndex = 3 Then
rngCell.Characters(I, 1).Font.ColorIndex = 5
'BLUE & Strikethrough becomes DELETED
'(replace orange color code)
ElseIf rngCell.Characters(I, 1).Font.ColorIndex = 5 _
And rngCell.Characters(I, 1).Font.Strikethrough = True Then
rngCell.Characters(I, 1).Delete
'Delete SPACE unnecessary
If rngCell.Characters(I + 1, 1).Text = " " Then _
rngCell.Characters(I + 1, 1).Delete
I = I - 1
'BLUE becomes AUTOMATIC COLOR
ElseIf rngCell.Characters(I, 1).Font.ColorIndex = 5 Then
rngCell.Characters(I, 1).Font.ColorIndex = _
xlColorIndexAutomatic
End If
Next I
Next
Set rngCell = Nothing

dteHourEnd = Timer
'Display the execution time of the sub, in seconde
MsgBox Format(dteHourEnd - dteHourStart, "# ##0.0000") & "s", _
vbInformation + vbMsgBoxRight, _
"Execution time of the sub (Seconde)"
Application.ScreenUpdating = True

'Test command syntax
'subColourUpdate Selection
End Sub
--~-----------------------------------------------------------------------~ --

Temps d'exécution moyen pour un document représentant 2 pages A4 bien
remplies : ~1,5 secondes
Si vous avez un moyen pour réduire encore ce temps : je suis preneur.
Mais sinon, je m'en contenterai.

Merci.

Dernière mouture.

.Characters ne fonctionne pas bien avec des valeurs de cellules
entièrement numériques. J'ai donc fait quelques petites adaptations :


--~-----------------------------------------------------------------------~ --

Sub subColourUpdate_NewIndice(rngPlage As Range)

Dim I As Integer
Dim rngCell As Range
Dim dteHourStart As Date
Dim dteHourEnd As Date
Dim dteHourTotal As String
Dim lngColorIndexNew As Long
Dim lngColorIndexPrevious As Long
Dim lngColorIndexDeleted As Long


Application.ScreenUpdating = False
dteHourStart = Timer

lngColorIndexNew = Range("rngColorIndexNew").Font.ColorIndex
lngColorIndexPrevious = Range("rngColorIndexPrevious").Font.ColorIndex
lngColorIndexDeleted = Range("rngColorIndexDeleted").Font.ColorIndex

'Convert all the range format to TEXT
rngPlage.NumberFormat = "@"
For Each rngCell In rngPlage.SpecialCells(xlCellTypeConstants)
'rngCell.Activate
'Convert the value of the cell to TEXT Data Type
If IsNumeric(rngCell.Value) Then _
rngCell.Value = CStr(rngCell.Value)

For I = 1 To Len(rngCell)
'NEW & DELETED becomes PREVIOUS
If rngCell.Characters(I, 1).Font.ColorIndex = lngColorIndexNew
_
Or rngCell.Characters(I, 1).Font.ColorIndex =
lngColorIndexDeleted Then
rngCell.Characters(I, 1).Font.ColorIndex =
lngColorIndexPrevious
'PREVIOUS & Strikethrough ARE Deleted
'(replace orange color code)
ElseIf rngCell.Characters(I, 1).Font.ColorIndex =
lngColorIndexPrevious _
And rngCell.Characters(I, 1).Font.Strikethrough = True Then
rngCell.Characters(I, 1).Delete
'Delete SPACE unnecessary
On Error Resume Next
If rngCell.Characters(I + 1, 1).Text = " " Then _
rngCell.Characters(I + 1, 1).Delete
If Len(rngCell) <> 0 Then I = I - 1
'PREVIOUS becomes AUTOMATIC COLOR
ElseIf rngCell.Characters(I, 1).Font.ColorIndex =
lngColorIndexPrevious Then
rngCell.Characters(I, 1).Font.ColorIndex = _
xlColorIndexAutomatic
End If
Next I
Next
Set rngCell = Nothing

dteHourEnd = Timer
'Display the execution time of the sub, in seconde
dteHourTotal = Format(dteHourEnd - dteHourStart, "# ##0.0000") & "s"
'MsgBox dteHourTotal, _
vbInformation + vbMsgBoxRight, _
"Execution time of the sub (Seconde)"
Range("C12") = dteHourTotal

Application.ScreenUpdating = True

'Test command syntax
'subColourUpdate_NewIndice Selection
End Sub

--~-----------------------------------------------------------------------~ --