Mettre en gras une sous-chaine de caractere dans une chaine de caractère

Bonjour à Tous,

Voilà le problème que j'essaye de résoudre:

Dans une feuille excel, j'ai une liste d'allergènes

Dans une autre feuille (même classeur), j'ai une liste de produits et leurs ingrédients. Certains de ces ingrédients sont des allergènes.

Je dois détecter si ces allergènes sont présents dans les produits et, s'ils existent, les mettre en gras afin qu'ils soient plus facilement repérables.

Pour l'instant je bloque car le composé allergène est détecté mais pas mis en gras,

Le code que j'utilise:

Sub texteengras()

Dim a As String

a = "Catalogue"

Dim b As String

b = "Allergènes"

c = "Trad. Danois"

Dim i, j As Integer 'i et j= indices pour feuille "Allergènes"

Dim derlig_b As Long

derlig_b = Sheets(b).Range("B65536").End(xlUp).Row

Dim y, z As Integer 'y et z= compteurs pour feuille Trad. Danois

Dim derlig_c As Integer

derlig_c = Sheets(c).Range("E65536").End(xlUp).Row

i = 3

For y = 2 To derlig_c

string_c = Sheets(c).Range("E:E").Cells(y, 1)

allergene = Sheets(b).Range("B:B").Cells(i, 1)

pos = InStr(Sheets(c).Range("E:E").Cells(y, 1), allergene)

longueur = Len(allergene)

While pos > 0

For i = 3 To derlig_b

allergene = Sheets(b).Range("B:B").Cells(i, 1)

pos = InStr(Sheets(c).Range("E:E").Cells(y, 1), allergene)

string_c = Replace(string_c, allergene, Sheets(b).Range("B:B").Cells(i, 1).Font.Bold = True)

Next i

Wend

Next y

End Sub

Je vous remercie de votre aide pour me sortir de l'ornière...

33catalogue.xlsm (190.68 Ko)

Bonjour,

Avec l' enregistreur de macro je crois qu'excel met en gras la portion de chaîne allant du caractère numéro x au caractère numéro y.

Donc dans votre cas si allergènes il y a il faut trouver ses positions de départ et d'arrivée afin d'y appliquer "le gras"

Mais ça c'est parce que je ne suis pas bon ! Il y a peut être plus simple...

@ bientôt

LouReeD

With ActiveCell.Characters(start:=13, length:=4).Font
.FontStyle = "Gras" 
End Whith

Ici on met en gras du caractère 13 au caractère 16, car du caractère 13 compris avec une longueur de 4 ça fait 16.

@ bientôt

LouReeD

Reste plus qu'à trouver la position de départ de l'allergene car sa longueur vous la connaissez puisque vous le cherchez..

@ bientôt

LouReeD

Merci beaucoup pour votre réponse, je regarde ça...

Est ce que cette procédure fonctionne si l’allergene Est présent plusieurs fois dans la chaîne de caractère ?

Merci

Attention ! la procédure ne trouve pas le mot !

Il faut trouver la position des mots dans la chaine et une fois la position trouvée appliquer la mise en forme.

Cette procédure de recherche serait à effectuer tant qu'il "reste" des caractères à la chaine, du coup test après test il sera possible de mettre en gras plusieurs fois le même allergène.

@ bientôt

LouReeD

Bonsoir,

ci dessous un code qui scanne les allergènes un par un et qui met en gras et en rouge l'allergène trouvé :

Sub Gras_et_Rouge()
    Dim Position As Integer ' position du premier caractère de l'allergène trouvé
    Dim NO_Caractère As Integer ' numéro du caractère de départ pour la recherche
    Dim Chaine As String ' variable contenant la chaine à transformer
    Dim Allergène() ' tableau des allergènes à chercher
    Dim Bcl As Integer ' variable pour boucler sur le tableau des allergènes

    Chaine = Range("A1").Value
    Allergène() = Array("Sucre", "Blé", "Gluten", "Sel", "Oeufs")
    NO_Caractère = 1
    ' on boucle le tableau des allergène de 0 à l'indice supérieur du tableau
    For Bcl = 0 To UBound(Allergène)
        ' boucle "indéfinie" sur la chaine testée
        Do
            ' on cherche le numéro de caractère dans la chaine où l'allergène "commence"
            ' ce test se fait avec les mots en "majuscule", comme cela il y a la même casse
            Position = InStr(NO_Caractère, UCase(Chaine), UCase(Allergène(Bcl)))
            ' si on trouve une position = allergène trouvé, on met en rouge et en gras
            ' à partir du premier caractère trouvé de l'allergène sur une longueur égale à la longueur de l'allergène
            If Position > 0 Then
                Range("A1").Characters(Start:=Position, Length:=Len(Allergène(Bcl))).Font.Bold = True
                Range("A1").Characters(Start:=Position, Length:=Len(Allergène(Bcl))).Font.Color = RGB(255, 0, 0)
                ' la prochaine recherche se fait à partir du caractère suivant le dernier de l'allergène
                NO_Caractère = Position + Len(Allergène(Bcl))
            Else
                ' si pas de retour c'est qu'il n'y a plus l'allergène recherché dans la chaine, on sort de la boucle
                Exit Do
            End If
        Loop
        ' on recommence au début de la chaine pour l'allergène suivant
        NO_Caractère = 1
    Next Bcl
    ' le tableau des allergènes a été scanné, la procédure est finie
End Sub

Evidemment le code ici "n'est pas fini" car il ne teste que la cellule A1 !

Mais le principe est là !

@ bientôt

LouReeD

Bonsoir,

le principe est là mais la réponse est absente...

@ bientôt

LouReeD

Bonsoir à tous,

Du recyclage de fichier . Un essai dans le fichier joint. Le bouton "Hop!" est associé à la macro TEST (modulel1):

Sub test()
  Chercher_Colorier_plage_liste Sheet2.Range("e2:e400"), Sheet5.Range("b3:b18")
  MsgBox "C'est terminé."
End Sub

Chercher_Colorier_plage_liste est une procédure avec deux arguments en entrée :

  • le premier argument (xrgTxt) est la plage où rechercher les valeurs à mettre en forme (la plage peut être réduite à une seule cellule)
  • le second argument (xrgQuoi) est la plage des textes à rechercher (la plage peut être réduite à une seule cellule)
  • la procédure colore les textes trouvés en appliquant la mise en forme des textes à rechercher (caractère par caractère). Par mise en forme, on entend la graisse et la couleur
  • le code de la procédure (et des procédures appelées) sont dans module1

Bonsoir,

du recyclage mais toujours pas de retour...

Mais pourquoi caractère par caractère vu que vous connaissez le mot et sa longueur ?

@ bientôt

LouReeD

Bonjour LouReed,

Mais pourquoi caractère par caractère vu que vous connaissez le mot et sa longueur ?

Parce que c'est du véritable recyclage

J'avais commis ce code pour un autre forum dans un contexte légèrement différent et j'ai repris tel quel sans le modifier pour excel-pratique. Avec l'âge on s'économise, non pas pour aller plus loin, mais pour aller plus longtemps

C'est sur avec 8 ans de plus qu'à votre inscription... Moi cela fait 4 ans et demi

Mais du côté "demandeur" toujours pas de retour...

Au fait, pour vous maintenir en forme, avez vous essayé MEGA BLOKS ma dernière application téléchargeable ?

@ bientôt

LouReeD

Bonjour à tous, LouReeD

Je reviens sur mon précédent code ( version v1) -> il présente l'inconvénient majeur de colorer trop de mots.

En effet, si on recherche le mot "lait", il colorera aussi le début du mot "laitue". Ce qui n'est pas bien du tout

J'ai donc modifié le code pour aboutir au code de la v2 afin de pallier ce comportement parasite.

On considère que tout ce qui n'est pas une lettre est un séparateur de mots - si les chiffres ne sont pas un séparateur, alors dans le code ( et pas les déclarations) remplacer lettres par LettresChiffres.

Peut-être aura-t-on un jour une réponse de demandeur ?

Transformer le code c'est fait. Allez! Goodnight ladies...

Nota : seules les déclarations des constantes et la procédure Sub Chercher_Colorier_un_un ont été modifiées.

Re LouReed,

Au fait, pour vous maintenir en forme, avez vous essayé MEGA BLOKS ma dernière application téléchargeable ?

Je vais aller y voir....

Rechercher des sujets similaires à "mettre gras chaine caractere"