Champ de Recherche via VB avec liens
Résolu/Fermé
touroul
Messages postés
475
Date d'inscription
mardi 5 octobre 2010
Statut
Membre
Dernière intervention
11 novembre 2024
-
19 avril 2022 à 19:57
touroul Messages postés 475 Date d'inscription mardi 5 octobre 2010 Statut Membre Dernière intervention 11 novembre 2024 - 21 avril 2022 à 07:42
touroul Messages postés 475 Date d'inscription mardi 5 octobre 2010 Statut Membre Dernière intervention 11 novembre 2024 - 21 avril 2022 à 07:42
A voir également:
- Champ de Recherche via VB avec liens
- Vb - Télécharger - Langages
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Vb cable - Télécharger - Audio & Musique
- Partager des photos via un lien - Guide
- Rechercher ou entrer l'adresse mm - recherche google - Guide
2 réponses
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
20 avril 2022 à 16:49
20 avril 2022 à 16:49
Bonjour,
Je t'ai mis le nom de la feuille et l'adresse du mot recherché. Avec cela tu peux facilement faire le lien hypertexte avec l'enregistreur de macro .
se déclenche au clic dans la listbox
Voilà, à toi de jouer
Je t'ai mis le nom de la feuille et l'adresse du mot recherché. Avec cela tu peux facilement faire le lien hypertexte avec l'enregistreur de macro .
se déclenche au clic dans la listbox
Option Compare Text Dim nom As String Dim DerniereLigneUtilisee As Long Private Sub ListBox1_Click() Dim i As Byte 'boucle sur les éléments de la listbox For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then nom = ListBox1.List(i) Next i SearchAllSheets 'recherche dans toutes les feuilles End Sub Private Sub TextBox1_Change() Application.ScreenUpdating = False Range("A2:A24").Interior.ColorIndex = 2 ListBox1.Clear If TextBox1 <> "" Then For ligne = 2 To 24 If Cells(ligne, 1) Like "*" & TextBox1 & "*" Then Cells(ligne, 1).Interior.ColorIndex = 43 ListBox1.AddItem Cells(ligne, 1) End If Next End If End Sub Sub SearchAllSheets() 'recherche dans toutes les feuilles 'JE McGimpsey, mpep Dim strSearchString As String Dim ws As Worksheet Dim foundCell As Range Dim returnValue As Variant Dim loopAddr As String Dim countTot As Long Dim counter As Long strSearchString = nom For Each ws In Worksheets countTot = countTot + Application.CountIf( _ ws.UsedRange, "=" & strSearchString) Next ws If countTot = 0 Then MsgBox strSearchString & " not found." Else counter = 0 For Each ws In Worksheets With ws .Activate Set foundCell = .Cells.Find( _ What:=strSearchString, _ LookIn:=xlValues, _ LookAt:=xlPart) If Not foundCell Is Nothing Then loopAddr = foundCell.Address Do counter = counter + 1 foundCell.Activate returnValue = MsgBox(ws.Name & " Found '" & strSearchString & _ "' at " & foundCell.Address & vbNewLine & _ "(" & counter & " of " & countTot & ")", _ vbOKCancel) DerniereLigneUtilisee = Range("H" & Rows.Count).End(xlUp).Row + 1 Range("H" & DerniereLigneUtilisee).Value = ws.Name 'nom de la feuille Range("I" & DerniereLigneUtilisee).Value = foundCell.Address 'adresse If returnValue = vbCancel Then Exit For Set foundCell = .Cells.FindNext( _ After:=foundCell) Loop While Not foundCell Is Nothing And _ foundCell.Address <> loopAddr End If End With Next ws End If End Sub 'SearchAllShee
Voilà, à toi de jouer
touroul
Messages postés
475
Date d'inscription
mardi 5 octobre 2010
Statut
Membre
Dernière intervention
11 novembre 2024
16
21 avril 2022 à 07:42
21 avril 2022 à 07:42
Bonjour LePivert
Un grand merci pour ton aide, c'est vraiment appréciable.
J'imagine que tu y as passé du temps, mais en effet ça fonctionne.
J'ai besoin d'un peu de temps pour adapter ça comme je veux, mais dans les grandes lignes j'ai compris, je vais adapter.
Pour les liens hypertextes, en effet je devrais arriver à me débrouiller.
Je marque en Résolu, mais si j'ai des soucis je reviendrai poster ici.
Bonne journée et merci encore.
Un grand merci pour ton aide, c'est vraiment appréciable.
J'imagine que tu y as passé du temps, mais en effet ça fonctionne.
J'ai besoin d'un peu de temps pour adapter ça comme je veux, mais dans les grandes lignes j'ai compris, je vais adapter.
Pour les liens hypertextes, en effet je devrais arriver à me débrouiller.
Je marque en Résolu, mais si j'ai des soucis je reviendrai poster ici.
Bonne journée et merci encore.