Bon vous l'aurez voulu!!!!!!
1er programme :
Dim chemin, mot_clef As String
Dim valid, lancement, fin, k, choix As Integer
Dim ok As Boolean
Dim fso, Dossier, Flder As Object
Dim fichier
Dim cellule As Integer
Dim Msg1, Msg2, Style, Title, Box
Dim nb, derniere_colonne
Dim cellul As String
Sub main()
If lancement = 0 Then
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
OptionButton4.Value = False
OptionButton5.Value = False
OptionButton6.Value = False
OptionButton7.Value = False
choix = 0
lancement = 1
End If
End Sub
Private Sub erreur()
mot_clef = Mot
Msg1 = "Vous n'avez pas choisi de type de recherche!"
Msg2 = "Vous n'avez saisi aucune recherche!"
Style = vbOKOnly + vbExclamation
Title = "Erreur!"
valid = 0
If (choix = 0) Then
Box = MsgBox(Msg1, Style, Title)
ElseIf Mot = "" Then
Box = MsgBox(Msg2, Style, Title)
Else
valid = 1
End If
Mot = ""
End Sub
Function select_a_folder(message, directory)
ok = False
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, message, NO_OPTIONS, directory)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
select_a_folder = "ANNUL"
Else
select_a_folder = objFolderItem.Path
ok = True
End If
On Error GoTo 0
End Function
Private Sub OptionButton1_Click()
choix = 1
End Sub
Private Sub OptionButton2_Click()
choix = 3
End Sub
Private Sub OptionButton3_Click()
choix = 4
End Sub
Private Sub OptionButton4_Click()
choix = 4
End Sub
Private Sub OptionButton5_Click()
choix = 5
End Sub
Private Sub OptionButton6_Click()
choix = 6
End Sub
Private Sub OptionButton7_Click()
choix = 8
End Sub
Private Sub Recherche_Click()
erreur
If valid = 1 Then
chemin = select_a_folder("Veuillez sélectionner un dossier dans lequel s'effectuera la recherche par " & choix & " de " & Mot & "", "c:\Convoyeurs\EXCEL\")
If ok = True Then
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("A7:L65536").Clear
Application.Workbooks("recherche.xls").Worksheets("listing").Cells.Clear
lister
chercher
End If
End If
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("A" & k & "").Select
MsgBox ("" & ((k - 7) / 4) & " résultat(s) trouvé(s)")
End Sub
Function chercher()
k = 7
For cellule = 3 To (derniere_colonne + 2)
fin = Application.Workbooks("recherche.xls").Worksheets("listing").Cells(65536, cellule).End(xlUp).Row
For a = 1 To fin
Workbooks.Open Feuil2.Cells(a, cellule).Value
fichier = Split(Feuil2.Cells(a, cellule).Value, "\")
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, choix).End(xlUp).Row
For i = 20 To LaDerniere
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(i, choix).Value = mot_clef Then
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & (i + 3) & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("A" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 4
End If
Next i
Application.Workbooks(fichier(4)).Activate
ActiveWorkbook.Close
Next a
Next cellule
mot_clef = ""
End Function
Function lister()
TousLesDossiers "" & chemin & "", 0
TousLesFichiers
End Function
Function TousLesDossiers(LeDossier$, Idx As Long)
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Feuil2.Range("a" & Idx & "").Value = Flder.Path
Next
Set fso = Nothing
End Function 'fs
Function TousLesFichiers()
Set fs = Application.FileSearch
If Feuil2.Range("A1").Value = "" Then
Feuil2.Range("A1").Value = Dossier
derniere_colonne = 1
Else
derniere_colonne = 4
End If
For F = 1 To derniere_colonne
With fs
.LookIn = "" & Feuil2.Range("A" & F & "").Value & ""
.Filename = "*"
.Execute
For i = 1 To .FoundFiles.Count
If F = 1 Then
cellul = "C"
ElseIf F = 2 Then
cellul = "D"
ElseIf F = 3 Then
cellul = "E"
ElseIf F = 4 Then
cellul = "F"
End If
Feuil2.Range("" & cellul & "" & i & "").Value = .FoundFiles(i)
Next i
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
Next F
End Function
2ème programme :
Dim chemin, mot_clef, mode As String
Dim valid, lancement, fin, k, choix As Integer
Dim ok As Boolean
Dim fso, Dossier, Flder As Object
Dim fichier
Dim cellule As Integer
Dim Msg1, Msg2, Style, Title, Box
Dim nb, derniere_colonne
Dim cellul As String
Sub main()
If lancement = 0 Then
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
OptionButton4.Value = False
OptionButton5.Value = False
OptionButton6.Value = False
OptionButton7.Value = False
OptionButton8.Value = False
OptionButton9.Value = False
OptionButton10.Value = False
OptionButton11.Value = False
choix = 0
lancement = 1
mode = ""
End If
End Sub
Private Sub erreur()
mot_clef = mot
Msg1 = "Vous n'avez pas choisi de type de recherche!"
Msg2 = "Vous n'avez saisi aucune recherche!"
Style = vbOKOnly + vbExclamation
Title = "Erreur!"
valid = 0
If (choix = 0) Then
Box = MsgBox(Msg1, Style, Title)
ElseIf mot = "" And mode <> "modif" Then
Box = MsgBox(Msg2, Style, Title)
Else
valid = 1
End If
mot = ""
End Sub
Function select_a_folder(message, directory)
ok = False
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, message, NO_OPTIONS, directory)
On Error Resume Next
Set objFolderItem = objFolder.Self
If Err <> 0 Then
select_a_folder = "ANNUL"
Else
select_a_folder = objFolderItem.Path
ok = True
End If
On Error GoTo 0
End Function
Private Sub OptionButton1_Click()
mode = "colonne"
choix = 1
End Sub
Private Sub OptionButton2_Click()
mode = "colonne"
choix = 3
End Sub
Private Sub OptionButton3_Click()
mode = "colonne"
choix = 4
End Sub
Private Sub OptionButton4_Click()
mode = "colonne"
choix = 4
End Sub
Private Sub OptionButton5_Click()
mode = "colonne"
choix = 5
End Sub
Private Sub OptionButton6_Click()
mode = "colonne"
choix = 6
End Sub
Private Sub OptionButton7_Click()
mode = "colonne"
choix = 8
End Sub
Private Sub OptionButton8_Click()
mode = "modif"
choix = 1
End Sub
Private Sub OptionButton9_Click()
mode = "partie"
choix = 1
End Sub
Private Sub OptionButton10_Click()
mode = "intervalle"
choix = 1
End Sub
Private Sub OptionButton11_Click()
mode = "cellule"
End Sub
Private Sub Recherche_Click()
erreur
If valid = 1 Then
If mode = "modif" Then
chemin = select_a_folder("Veuillez sélectionner un dossier dans lequel s'effectuera la recherche de toutes les modifications", "c:\Convoyeurs\EXCEL\")
Else
chemin = select_a_folder("Veuillez sélectionner un dossier dans lequel s'effectuera la recherche de " & mot_clef & "", "c:\Convoyeurs\EXCEL\")
End If
If ok = True Then
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("A7:M65536").Clear
Application.Workbooks("recherche.xls").Worksheets("listing").Cells.Clear
lister
chercher
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("A" & k & "").Select
MsgBox ("" & (k - 7) & " résultat(s) trouvé(s)")
End If
End If
End Sub
Function chercher()
k = 7
For cellule = 3 To (derniere_colonne + 2)
fin = Application.Workbooks("recherche.xls").Worksheets("listing").Cells(65536, cellule).End(xlUp).Row
For a = 1 To fin
Workbooks.Open Feuil2.Cells(a, cellule).Value
fichier = Split(Feuil2.Cells(a, cellule).Value, "\")
If mode = "colonne" Then
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, choix).End(xlUp).Row
For i = 20 To LaDerniere
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(i, choix).Value = mot_clef Then
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & i & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("B" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 1
End If
Next i
ElseIf mode = "modif" Then
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, choix).End(xlUp).Row
For i = 20 To LaDerniere
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(i, choix).Value <> "" Then
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & i & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("B" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 1
End If
Next i
ElseIf mode = "cellule" Then
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("C5").Value = mot_clef Then
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, 1).End(xlUp).Row
For i = 20 To LaDerniere
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & i & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("B" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 1
Next i
End If
ElseIf mode = "partie" Then
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, choix).End(xlUp).Row
For i = 20 To LaDerniere
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(i, choix).Value <> "" Then
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & i & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("B" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 1
End If
Next i
ElseIf mode = "intervalle" Then
LaDerniere = Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(65536, choix).End(xlUp).Row
For i = 20 To LaDerniere
If Application.Workbooks(fichier(4)).Worksheets("Tableau").Cells(i, choix).Value <> "" Then
Application.Workbooks(fichier(4)).Worksheets("Tableau").Range("A" & i & ":L" & i & "").Copy
Application.Workbooks("recherche.xls").Worksheets("Résultats").Activate
Application.Workbooks("recherche.xls").Worksheets("Résultats").Range("B" & k & "").Select
ActiveSheet.Paste
With Worksheets("Résultats")
.Hyperlinks.Add .Range("A" & k & ""), Feuil2.Cells(a, cellule).Value
End With
k = k + 1
End If
Next i
End If
Application.Workbooks(fichier(4)).Activate
ActiveWorkbook.Close
Next a
Next cellule
mot_clef = ""
End Function
Function lister()
TousLesDossiers "" & chemin & "", 0
TousLesFichiers
End Function
Function TousLesDossiers(LeDossier$, Idx As Long)
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Feuil2.Range("a" & Idx & "").Value = Flder.Path
Next
Set fso = Nothing
End Function 'fs
Function TousLesFichiers()
Set fs = Application.FileSearch
If Feuil2.Range("A1").Value = "" Then
Feuil2.Range("A1").Value = Dossier
derniere_colonne = 1
Else
derniere_colonne = 4
End If
For F = 1 To derniere_colonne
With fs
.LookIn = "" & Feuil2.Range("A" & F & "").Value & ""
.Filename = "*"
.Execute
For i = 1 To .FoundFiles.Count
If F = 1 Then
cellul = "C"
ElseIf F = 2 Then
cellul = "D"
ElseIf F = 3 Then
cellul = "E"
ElseIf F = 4 Then
cellul = "F"
End If
Feuil2.Range("" & cellul & "" & i & "").Value = .FoundFiles(i)
Next i
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
Next F
End Function
Dites moi ce qui différe l'un de l'autre mise à part les conditions if mode ="..." parce que là je vois pas ce qui fait merder mon programme!!!
