XL 2016 erreur 424

MURET31 · 19 Mai 2019

Bonjour,
Via la macro ci-dessous, je cherche à colorier en rouge tous les mots "toto" dans ma feuille active, cependant à chaque lancement de la macro j'ai une erreur "424 Objet requis" que je n'arrive pas à résoudre. Pourriez-vous m'aider s'il vous plaît?

L'erreur 424 souligne en jaune "With ActiveDocument.Content.Find"

VB:

Sub ColourChange()
Application.ScreenUpdating = False
Dim arrWords, i As Long
arrWords = Array("toto", "2nd string", "3rd string")
With ActiveDocument.Content.Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = True
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  With .Replacement
    .ClearFormatting
    .Text = "^&"
    .Font.Color = wdColorRed
  End With
  For i = 0 To UBound(arrWords)
    .Text = arrWords(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

Staple1600 · 19 Mai 2019

Bonjour

MURET31
ActiveDocument.Content.Find concerne un document Word or tu parles de feuille

Donc ton document c'est un classeur Excel ou un document Word?

Hasco · 19 Mai 2019

Bonjour,

C'est n'est pas une macro Excel mais Word. Normal qu'excel ne connaisse pas ActiveDocument et encore moins son .Content.

bon après-midi

Edit: Re- Bing @Staple1600

Staple1600 · 19 Mai 2019

Re, Roblochon

Tu ne fus point assez rapide, lol
(cf message#2)

Désolé pour la collision

MURET31 · 19 Mai 2019

Bonjour JM,
Je te remercie pour ton retour.
En effet c'est un document excel, j'ai déjà essayé ActiveSheet("nom") et toujours la même erreur.
Merci
MU

Staple1600 · 19 Mai 2019

Re

Comme Roblochon et moi-même venons de te le dire, c'est une macro destinée à un document Word.
Elle ne peut pas fonctionner sur une feuille Excel.

MURET31 · 19 Mai 2019

Roblochon à dit:
Bonjour,

C'est ne pas une macro Excel mais Word. Normal qu'excel ne connaisse pas ActiveDocument et encore moins son .Content.

bon après-midi

Edit: Re- Bing @Staple1600

Merci pour vos réponses rapides, y aurait-il un moyen de l'adapter à excel? auriez-vous une macro plus simple que pourrais adapter s'il vous plaît? cela fait deux jours que je cherche
Merci
MU

Staple1600 · 19 Mai 2019

Re

Essaies cette macro basique
(je viens de le faire -test OK)

VB:

Sub EnRougeEtRouge_JeanneMas_Tribute()
Dim c As Range
Application.ScreenUpdating = False
    For Each c In ActiveSheet.UsedRange
        If InStr(c.Value, "toto") > 0 Then
          c.Interior.Color = vbRed
        End If
    Next c
End Sub

Staple1600 · 19 Mai 2019

Re

Une autre pour le fun
(et/ou pour les oreilles cf commentaires en vert )

VB:

Sub RoteRosen_roteLippen_roterWein()
Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
c.Interior.Color = Choose(InStr(c.Value, "toto") + 1, xlNone, vbRed)
Next c
'petit bonus pour les curieux:https://www.youtube.com/watch?v=ixjKO4OwICw
End Sub

MURET31 · 19 Mai 2019

Staple1600 à dit:
Re

Essaies cette macro basique
(je viens de le faire -test OK)

VB:

Sub EnRougeEtRouge_JeanneMas_Tribute() Dim c As Range Application.ScreenUpdating = False For Each c In ActiveSheet.UsedRange If InStr(c.Value, "toto") > 0 Then c.Interior.Color = vbRed End If Next c End Sub

Merci Staple1600
Je te remercie pour cette proposition, j'ai l'erreur 13 "incompatibilité de type" sur la ligne "If InStr(c.Value, "toto") > 0 Then"
Merci
MU

MURET31 · 19 Mai 2019

MURET31 à dit:
Merci Staple1600
Je te remercie pour cette proposition, j'ai l'erreur 13 "incompatibilité de type" sur la ligne "If InStr(c.Value, "toto") > 0 Then"
Merci
MU

Je cherche à colorier uniquement le mot "toto".
Merci
MU

Staple1600 · 19 Mai 2019

Re

Moi je ne l'ai pas cette erreur
(comme je l'avais précisé)

(je viens de le faire -test OK)

Sans doute parce, j'avais des totos dans certaines cellules de ma feuille active.

Et toi?
As-tu des toto dans ta feuille?

MURET31 · 19 Mai 2019

Staple1600 à dit:
Re

Moi je ne l'ai pas cette erreur
(comme je l'avais précisé)

Sans doute parce, j'avais des totos dans certaines cellules de ma feuille active.

Et toi?
As-tu des toto dans ta feuille?

En effet cela fonctionne mais la cellule est coloriée or je cherche à colorier uniquement le mot.
Autre précision j'utilise des cellules fusionnées.
Par avance merci
MU

Staple1600 · 19 Mai 2019

Re

Alors pour le fun mais pas que
Ci-dessous une macro avec parametres
Lance la macro nommée Macro_Rougissante

VB:

Sub Macro_Rougissante()
MakeMe_Red ActiveSheet.UsedRange, "toto"
End Sub
Private Sub MakeMe_Red(Vamos_A_LA_Playa As Range, LeMot As String, Optional PurpleRainOrNOt As XlColorIndex = 3)
Dim c As Range
Application.ScreenUpdating = False
For Each c In Vamos_A_LA_Playa
If InStr(c.Value, LeMot) > 0 Then
c.Characters(InStr(c.Value, LeMot), Len(LeMot)).Font.ColorIndex = PurpleRainOrNOt
End If
Next c
End Sub

PS: Si tu as des questions sur la syntaxe, elles sont les bienvenues

NB: test OK sur mon PC.

MURET31 · 19 Mai 2019

Staple1600 à dit:
Re

Alors pour le fun mais pas que
Ci-dessous une macro avec parametres
Lance la macro nommée Macro_Rougissante

VB:

Sub Macro_Rougissante() MakeMe_Red ActiveSheet.UsedRange, "toto" End Sub Private Sub MakeMe_Red(Vamos_A_LA_Playa As Range, LeMot As String, Optional PurpleRainOrNOt As XlColorIndex = 3) Dim c As Range Application.ScreenUpdating = False For Each c In Vamos_A_LA_Playa If InStr(c.Value, LeMot) > 0 Then c.Characters(InStr(c.Value, LeMot), Len(LeMot)).Font.ColorIndex = PurpleRainOrNOt End If Next c End Sub

PS: Si tu as des questions sur la syntaxe, elles sont les bienvenues

NB: test OK sur mon PC.

Merci Staple1600
Cela marche parfaitement sur des cellules non fusionnées, aurais tu la solution pour des cellules fusionnées stp et si je veux rajouter plusieurs "string" exemple: (toto1) (toto2).
C'est déjà un très bon début pour moi
Merci encore
MU

XL 2016 erreur 424

MURET31

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

MURET31

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

MURET31

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

MURET31

XLDnaute Nouveau

MURET31

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

MURET31

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

MURET31

XLDnaute Nouveau

Discussions similaires