XL 2019 [VBA] Recherche/Surlignage ZoneTexte

jiks1

XLDnaute Nouveau
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
 

Pièces jointes

  • testrecherchebloctext.xlsm
    333.8 KB · Affichages: 13
Solution
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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.
 

Pièces jointes

  • testrecherchebloctext.xlsm
    337.1 KB · Affichages: 9
Dernière édition:

jiks1

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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 ;)
 

Discussions similaires

Statistiques des forums

Discussions
311 723
Messages
2 081 932
Membres
101 844
dernier inscrit
pktla