1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
|
Public Sub RechercheDansTitre(objForm As Object)
Dim n As Integer
Dim n2 As Integer
Dim TrouveData As Boolean
Dim Ligne As Single
Test_OperationEnCours = True
'-----
objForm.FrmResultatRecherche.ScrollTop = 0
objForm.FrmResultatRecherche.ScrollHeight = 0
objForm.LblGlass.ZOrder (0)
DataRecherche.LblGlass.Height = 260
objForm.FrmResultatRechercheScroll.Height = 260 '20 * 13
'-----
Call ControlSuprimer(objForm, objForm.FrmResultatRechercheScroll)
'-----
objForm.BoxNumFilmTotal.Text = ""
objForm.BoxNumFilmFound.Text = ""
'----- variable de recherche et controle des CheckBox
If objForm.ChkMot1.Value = True And objForm.TxbMotEntier1 = "" And objForm.TxbMotPartiel1 = "" Then
objForm.ChkMot1.Value = False
Else
If objForm.TxbMotEntier1 <> "" Then TabMotEntierOU = Split(FormatMinusculeSimple(objForm.TxbMotEntier1), ";")
If objForm.TxbMotPartiel1 <> "" Then TabMotPartielOU = Split(FormatMinusculeSimple(objForm.TxbMotPartiel1), ";")
End If
If objForm.ChkMot2.Value = True And objForm.TxbMotEntier2 = "" And objForm.TxbMotPartiel2 = "" Then
objForm.ChkMot2.Value = False
Else
If objForm.TxbMotEntier2 <> "" Then TabMotEntierET = Split(FormatMinusculeSimple(objForm.TxbMotEntier2), ";")
If objForm.TxbMotPartiel2 <> "" Then TabMotPartielET = Split(FormatMinusculeSimple(objForm.TxbMotPartiel2), ";")
End If
If objForm.ChkMot3.Value = True And objForm.TxbMotEntier3 = "" And objForm.TxbMotPartiel3 = "" Then
objForm.ChkMot3.Value = False
Else
If objForm.TxbMotEntier3 <> "" Then TabMotEntierETOU = Split(FormatMinusculeSimple(objForm.TxbMotEntier3), ";")
If objForm.TxbMotPartiel3 <> "" Then TabMotPartielETOU = Split(FormatMinusculeSimple(objForm.TxbMotPartiel3), ";")
End If
'-----
'determine Onglet
If objForm.ChkListFilms.Value = True Then OngletName = OngletListFilms
'détermine LigneListFin
LigneListFin = ListFin(OngletName, ListColonTitre & ListLigneDebut, "U")
'Boucle de recherche dans OngletName
For n = ListLigneDebut To LigneListFin
objForm.BoxNumFilmTotalProgressBar.Width = (objForm.BoxNumFilmTotal.Width / LigneListFin) * n
DoEvents
'décompte des lignes de OngletName du Total vers zero
objForm.BoxNumFilmTotal.Text = LigneListFin - n
'----- Data de recherche
'Titre du film de la ligne ListColonTitre + n
'Formate le titre -->minuscule + caracteres simples
If objForm.ChkTitre.Value = True Then DataList = FormatMinusculeSimple(Sheets(OngletName).Range(ListColonTitre & n).Value)
'-----
TrouveData = False
If objForm.ChkMot1.Value = True Then
If objForm.TxbMotPartiel1 <> "" Then
For n2 = 0 To UBound(TabMotPartielOU)
If InStr(DataList, TabMotPartielOU(n2)) > 0 Then
TrouveData = True
Exit For
End If
Next n2
End If
If objForm.TxbMotEntier1 <> "" Then
For n2 = 0 To UBound(TabMotEntierOU)
If InStr(DataList, " " & TabMotEntierOU(n2) & " ") > 0 Then
TrouveData = True
Exit For
End If
Next n2
End If
End If
If TrouveData = True And objForm.ChkMot3.Value = True Then
If objForm.TxbMotPartiel3 <> "" Then
TrouveData = False
For n2 = 0 To UBound(TabMotPartielETOU)
If InStr(DataList, TabMotPartielETOU(n2)) > 0 Then
TrouveData = True
Exit For
End If
Next n2
End If
If TrouveData = True And objForm.TxbMotEntier3 <> "" Then
TrouveData = False
For n2 = 0 To UBound(TabMotEntierETOU)
If InStr(DataList, " " & TabMotEntierETOU(n2) & " ") > 0 Then
TrouveData = True
Exit For
End If
Next n2
End If
If TrouveData = True And objForm.ChkMot2.Value = True Then
If objForm.TxbMotPartiel2 <> "" Then
For n2 = 0 To UBound(TabMotPartielET)
If Not InStr(DataList, " " & TabMotPartielET(n2) & " ") > 0 Then
TrouveData = False
Exit For
End If
Next n2
End If
If TrouveData = True And objForm.TxbMotEntier2 <> "" Then
For n2 = 0 To UBound(TabMotEntierET)
If Not InStr(DataList, " " & TabMotEntierET(n2) & " ") > 0 Then
TrouveData = False
Exit For
End If
Next n2
End If
End If
ElseIf TrouveData = True And objForm.ChkMot2.Value = True Then
If objForm.TxbMotPartiel2 <> "" Then
For n2 = 0 To UBound(TabMotPartielET)
If Not InStr(DataList, " " & TabMotPartielET(n2) & " ") > 0 Then
TrouveData = False
Exit For
End If
Next n2
End If
If TrouveData = True And objForm.TxbMotEntier2 <> "" Then
For n2 = 0 To UBound(TabMotEntierET)
If Not InStr(DataList, " " & TabMotEntierET(n2) & " ") > 0 Then
TrouveData = False
Exit For
End If
Next n2
End If
End If
If TrouveData = True Then
Call ListDataAjouter(OngletName, n, Ligne)
Ligne = Ligne + 1
DataRecherche.BoxNumFilmFound.Value = Ligne
End If
'-----
Next n
objForm.BoxNumFilmTotalProgressBar.Width = 0
DataRecherche.LblGlass.ZOrder (0)
DataRecherche.FrmResultatRechercheScroll.Height = DataRecherche.BoxNumFilmFound.Value * 13 '13 = hauteur de txb
DataRecherche.LblGlass.Height = DataRecherche.FrmResultatRechercheScroll.Height
DataRecherche.FrmResultatRecherche.ScrollHeight = DataRecherche.FrmResultatRechercheScroll.Height
'----------------- uniquement pour test
DataRecherche.Controls("TxbScrTitre10").FontSize = 8
DataRecherche.Controls("TxbScrTitre10").Height = 13
'DataRecherche.Controls("FrmResultatRechercheScroll").Controls("TxbScrTitre10").BackColor = &H0
DataRecherche.Controls("TxbScrTitre11").FontSize = 8
DataRecherche.Controls("TxbScrTitre11").Height = 13
'DataRecherche.Controls("FrmResultatRechercheScroll").Controls("TxbScrTitre11").BackColor = &H0
Test_OperationEnCours = False
End Sub |
Partager