Const MA_FEUILLE As String = "Base documentaire" 'modif pour une seule feuille
Type structTitresColonnnes
Adresse As String
Categorie As Variant
Intitule As Variant
Nature As Variant
Inscription As Variant
Cloture As Variant
Sites As Variant
Programmes As Variant
Liens As Variant
End Type
Function Cherche(pmoWhat As String, pmoMatchCase As Boolean, pmoLookAt As Long) As Variant
Dim S As Worksheet
Dim R As Range
Dim First$
Dim Last$
Dim Colonnes() As structTitresColonnnes
Dim T()
Dim i&
Dim j&
Dim g&
Dim bool As Boolean
On Error GoTo Erreur
Application.EnableEvents = False
Application.DisplayAlerts = False
For Each S In ActiveWorkbook.Worksheets
If S.Name = "tempo___pmo" Then
S.Visible = xlSheetVisible
S.Delete
Exit For
End If
Next S
For Each S In ActiveWorkbook.Worksheets
If S.Name = MA_FEUILLE Then 'modif pour une seule feuille
Set R = S.Cells.Find(after:=S.[iv65536], What:=pmoWhat, MatchCase:=pmoMatchCase, _
LookAt:=pmoLookAt, SearchOrder:=xlByColumns)
If Not R Is Nothing Then
First$ = R.Address
Last$ = First$
GoSub Inscription
Do
Set R = S.Cells.FindNext(after:=S.Range(Last$))
If Not R Is Nothing And R.Address <> First$ Then
Last$ = R.Address
GoSub Inscription
End If
Loop While Not R Is Nothing And R.Address <> First$
End If
End If 'modif pour une seule feuille
Next S
If bool Then
Set S = Sheets.Add
S.Name = "tempo___pmo"
S.Visible = xlSheetVeryHidden
ReDim T(1 To UBound(Colonnes), 1 To 9)
For i& = 1 To UBound(T)
With Colonnes(i&)
T(i&, 1) = .Adresse
T(i&, 2) = .Categorie
T(i&, 3) = .Intitule
T(i&, 4) = .Nature
T(i&, 5) = .Inscription
T(i&, 6) = .Cloture
T(i&, 7) = .Sites
T(i&, 8) = .Programmes
T(i&, 9) = .Liens
End With
Next i&
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), UBound(T, 2)))
R = T
Cherche = R
End If
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Function
Erreur:
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Erreur " & Err.Number & vbCrLf & vbCrLf & Err.Description
Exit Function
'--------------
Inscription:
bool = True
g& = g& + 1
ReDim Preserve Colonnes(1 To g&)
With Colonnes(g&)
.Adresse = R.Parent.Name & "!" & R.Address(False, False)
Set R = S.Range("a" & R.Row & "")
.Categorie = R
.Intitule = R.Offset(0, 1)
.Nature = R.Offset(0, 2)
.Inscription = R.Offset(0, 3)
.Cloture = R.Offset(0, 4)
.Sites = R.Offset(0, 5)
.Programmes = R.Offset(0, 6)
.Liens = R.Offset(0, 7)
End With
Return
End Function
