Re : Multi Mini BD
Bonjour Chareos, le Forum.
@ Chareos ( et aux autres personnes que cela peut interesser ).
Ci-dessous la macro adaptée pour fonctionner avec MMBD...
La macro cherche une variable ( à saisir ) dans l'ensemble des BdD du classeur
et ce, quelque soit la BdD, la ligne ou la colonne.
( La navigation se fait au fil des résultats trouvés )
Coller cette macro dans le Navigateur.
Créer un bouton sur le Navigateur.
( Je conseille de le mettre près de la ComboBox de changement de BdD ).
Y accrocher la macro.
Cela devrait fonctionner...
( j'intègrerai ça en standard dans une prochaine version de MMBD )
Bon courage à tous et A+
Didier.
'===================================================
Sub RechercherDansFeuilles()
Dim Cherche1 As String
Dim Trouvé1 As Range
Dim Cherche2 As String
Dim Trouvé2 As Range
Dim i As Integer
Cherche1 = ""
Set Trouvé1 = Range("A2")
Cherche2 = ""
Set Trouvé2 = Range("A2")
Cherche1 = InputBox("Valeur à rechercher dans les bases de données de ce classeur..." & Chr$(13) & Chr$(13) & _
"( Ne pas utiliser les noms des colonnes )", "Multi Mini BD")
If Cherche1 = "" Or Cherche1 = " " Or Cherche1 = " " Or Cherche1 = " " Then Exit Sub
MultiPage1.Value = 0
NomBD.Enabled = False
For i = 1 To Sheets.Count
If ThisWorkbook.Sheets(i).Name = "MMBD_Extraction" Or _
ThisWorkbook.Sheets(i).Name = "MMBD_Analyse" Or _
ThisWorkbook.Sheets(i).Name = "MMBD_Guide" Then GoTo NePasChercher
Sheets(i).Select: Set Trouvé1 = Cells.Find(What:=Cherche1)
If Not Trouvé1 Is Nothing Then
If Trouvé1.Row = 1 Then
MsgBox Cherche1 & " = Nom de colonne " & Chr$(13) & Chr$(13) & "Fin de la recherche...", , "Multi Mini BD"
NomBD.Enabled = True
ThisWorkbook.Sheets(NomBD.Text).Activate
RetournerInfo
Exit Sub
End If
Trouvé1.Activate
With ActiveCell.Characters(Start:=InStr(1, Selection, Left(Cherche1, 1), 1), Length:=Len(Cherche1))
NomBD.Text = ThisWorkbook.Sheets(i).Name
Cells(Trouvé1.Row, 1).Activate
RetournerInfo
Trouvé1.Activate
End With
ChercherEncore:
Cherche2 = MsgBox("Poursuivre la recherche de : " & Cherche1 & " ?", vbYesNo, "Multi Mini BD")
If Cherche2 = vbYes Then
Set Trouvé2 = ActiveSheet.UsedRange.FindNext(After:=ActiveCell)
If Trouvé2.Row = 1 Then
MsgBox Cherche1 & " = Nom de colonne " & Chr$(13) & Chr$(13) & "Fin de la recherche...", , "Multi Mini BD"
NomBD.Enabled = True
ThisWorkbook.Sheets(NomBD.Text).Activate
RetournerInfo
Exit Sub
End If
If Trouvé2 Is Nothing Then
Cells(Trouvé2.Row, 1).Activate
RetournerInfo
Trouvé2.Activate
Else
Cells(ActiveCell.Row, 1).Activate
End If
Else
NomBD.Text = ThisWorkbook.Sheets(i).Name
Cells(ActiveCell.Row, 1).Activate
RetournerInfo
NomBD.Enabled = True
Exit Sub
End If
If Trouvé2.Address <> Trouvé1.Address Then
Trouvé2.Activate
With ActiveCell.Characters(Start:=InStr(1, Selection, Left(Cherche1, 1), 1), Length:=Len(Cherche1))
NomBD.Text = ThisWorkbook.Sheets(i).Name
Cells(Trouvé2.Row, 1).Activate
RetournerInfo
Trouvé2.Activate
End With
GoTo ChercherEncore
End If
End If
NePasChercher:
Next i
If ActiveCell.Row = 1 Then
Cells(ActiveCell.Row + 1, 1).Activate
Else
Cells(ActiveCell.Row, 1).Activate
End If
NomBD.Enabled = True
ThisWorkbook.Sheets(NomBD.Text).Activate
RetournerInfo
MsgBox "Fin de la recherche...", , "Multi Mini BD"
End Sub
'===================================================