XL 2019 [VBA] Recherche/Surlignage ZoneTexte

jiks1 · 12 Avril 2020

Bonjour tout le monde;

J'ai besoin d'aide, je m'arrache les cheveux pour essayer de faire une manipulation sous excel en VBA.
Est-il possible de faire des recherches de zone Texte et si on les trouve, les surligner ?

Dans mon fichier, j'ai une nomenclature sur la Feuil1, avec pour chaque pièce, une zone texte avec un numéro.
Sur ma feuille deux je voudrais pouvoir rentrer les numéros rechercher dans la colonnes A.

En actionnant ma macro, celle-ci rechercherait les numéros de la feuille 2 et surlignerais les zones texte correspondant à la liste de la feuille 2

Je vous lie un document pour illustrer mes propos.

Je vous remercie pour votre temps !
Je reste a votre disposition pour toute questions

Staple1600 · 13 Avril 2020

Re

Ne cherche plus
Je te laisse trouver quelle ligne dans celle nouvelle version de charge de: "toutes les cellules non vide de la colonne A"

VB:

Sub Test_Coloriage_II()
Dim vArr, i%, shp As Shape, f As Worksheet
Set f = Sheets("num")
vArr = f.Range(f.Cells(1), f.Cells(Rows.Count, 1).End(xlUp)).Value
For Each shp In ActiveSheet.Shapes
    If shp.Type = msoTextBox Then
        For i = LBound(vArr, 1) To UBound(vArr, 1)
        If vArr(i, 1) Like shp.TextFrame2.TextRange.Text Then
        shp.Fill.Visible = msoTrue
        shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
        shp.TextFrame2.TextRange.Font.Bold = msoTrue
        End If
        Next
    End If
Next
End Sub
Sub RAZ_Formes()
Dim shp As Shape
For Each shp In...

Staple1600 · 12 Avril 2020

Bonsoir le fil, jiks1

Si j'ai bien compris, test OK sur mon PC.

VB:

Sub Test_Surlignage_OK()
Dim shp As Shape, check$, mot$
mot = InputBox("Mot à rechercher :", "Rechercher")
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
    check = shp.TextFrame2.TextRange.Text
    If check Like mot Then
    shp.TextFrame2.TextRange.Font.UnderlineStyle = 2
    End If
End If
Next
End Sub

jiks1 · 12 Avril 2020

Bonsoir Staple1600,

Merci de ta réponse,

Cependant ce n'est pas exactement ce que je recherche.

En entrant dans la boite de dialogue le chiffre "8" cela ne surligne pas le chiffre 8 sur la feuille "vue" par ailleurs je pense que ce serais plus, un remplissage de la zone texte avec une couleur qui serais le plus indiqué.

Par ailleurs, il ne faudrait pas une boite inputbox qui me permette de rechercher mais une recherche automatique dans la colonne A de la feuille "num"

J'ai conscience que cela est compliqué et je vous remercie de m'accorder votre temps

Staple1600 · 12 Avril 2020

Re

Dans ce cas, sois plus précis dans la description de ta question
Je me contente de faire ce que je lis

Est-il possible de faire des recherches de zone Texte et si on les trouve, les surligner ?

Tu ne veux pas d'inputBox ?
Alors pourquoi c'est qu'on trouve dans ta macro:Sub recherchecontenuzone() ?

jiks1 · 12 Avril 2020

Re

Je sais, je te prit de m'excuser si je n'ai pas été assez claire dans ma description.

Désolé

Staple1600 · 12 Avril 2020

Re

Ne sois pas désolé.
Détaille plus précisément ta question
(Heureusement le mode Edition existe , donc ajoute détails et explications dans le message#1)

Ton message laissait entendre que tu voulais souligner le contenu d'une zone de texte selon le numéro saisi dans l'InputBox
(oui le même que celui qu'on trouve dans ta PJ)
C'est ce que se borne à faire ma macro

sousou · 12 Avril 2020

Bonsoir
Tu peux essayer comme ceci
Selectionne les valeurs à tester, et lance la macro r
Raz pour effacer le résultat
Sub r()
With Sheets("vue")
For Each n In Selection
valeur = n.Value

For Each i In .Shapes
If i.Type = 17 Then
If i.TextFrame2.TextRange.Text = CStr(valeur) Then Call souligne(i): Exit For
End If
Next
Next
End With
End Sub
Sub souligne(i)
With i.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent2
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
End Sub

Sub raz()
With Sheets("vue")
For Each i In .Shapes
If i.Type = 17 Then
With i.Fill
.Visible = msoFalse

End With
End If
Next
End With
End Sub
hello staple!!

jiks1 · 12 Avril 2020

Re,

Alors je vais essayer d'être le plus limpide possible

Sur ma feuille 1 "vue" j'ai une nomenclature, chaque chiffre est dans une ZoneText créer avec un numéro dans chaque. (1,2,3...)
Dans ma feuille 2 "num" j'ai la colonne A ou je met des numéro.

Ce que j'aimerai faire, c'est imaginons que je mette 1,5,6,8,9,11,18,16 dans la colonne A ( un numéro par ligne) voir comme dans le model.
En activant ma macro, celle ci recherche les numéros présente dans la feuille "num" colonne A.
Et colore les zone texte en jaune correspondant les numéros dans la feuille "vue"

En pj, une vision final de ce que ça donnerais après avoir effectué la macro.
(les numéros mis en feuille 2)
(Les zone de texte colorier selon la recherche en feuille 1 )

J’espère être plus claire.

Merci pour votre temps.

jiks1 · 12 Avril 2020

re,
Bonsoir Sousou,

Voila ça marche parfaitement ! est-il possible de, au lieu de devoir sélectionner, cela sélectionne automatiquement toutes les cellules non vide de la colonne A ?

En tout cas merci beaucoup a vous deux pour votre aide !

Staple1600 · 12 Avril 2020

Re

Dans mon dictionnaire, surligner n'est pas synonyme de colorier...
Et l'adaptation n'était pas compliquée, non ?

VB:

Sub Test_Coloriage()
Dim vArr, shp As Shape, check
vArr = Feuil2.Range("A1:A8").Value
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
If shp.TextFrame2.TextRange.Text <> "17bis" Then
check = Application.Match(CLng(shp.TextFrame2.TextRange.Text), vArr, 0)
If Not IsError(check) Then
shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
End If
End If
End If
Next
End Sub

EDITION: Bonsoir sousou

Staple1600 · 12 Avril 2020

Re

•>jiks1
Faut mouiller un peu le maillot, camarade!

est-il possible de, au lieu de devoir sélectionner, cela sélectionne automatiquement toutes les cellules non vide de la colonne A ?

Ce genre de syntaxe VBA pullule dans les archives du forum.
Il suffit de chercher

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

jiks1 · 12 Avril 2020

Re
Tu as raison je vais aller chercher, le plus gros est fait. Je vous remercie vous deux !
Bonne soirée a vous ! et encore merci !

Staple1600 · 13 Avril 2020

Re

Ne cherche plus
Je te laisse trouver quelle ligne dans celle nouvelle version de charge de: "toutes les cellules non vide de la colonne A"

VB:

Sub Test_Coloriage_II()
Dim vArr, i%, shp As Shape, f As Worksheet
Set f = Sheets("num")
vArr = f.Range(f.Cells(1), f.Cells(Rows.Count, 1).End(xlUp)).Value
For Each shp In ActiveSheet.Shapes
    If shp.Type = msoTextBox Then
        For i = LBound(vArr, 1) To UBound(vArr, 1)
        If vArr(i, 1) Like shp.TextFrame2.TextRange.Text Then
        shp.Fill.Visible = msoTrue
        shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
        shp.TextFrame2.TextRange.Font.Bold = msoTrue
        End If
        Next
    End If
Next
End Sub
Sub RAZ_Formes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Type = msoTextBox Then
shp.Fill.Visible = 0: shp.TextFrame2.TextRange.Font.Bold = 0
End If
Next
End Sub

Bonne nuit et bon lundi de Pâques

XL 2019 [VBA] Recherche/Surlignage ZoneTexte

jiks1

XLDnaute Nouveau

Pièces jointes

Staple1600

Staple1600

XLDnaute Barbatruc

jiks1

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

jiks1

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

sousou

XLDnaute Barbatruc

jiks1

XLDnaute Nouveau

Pièces jointes

jiks1

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Effectuez une recherche sur Excel Downloads...

jiks1

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires