no save
Assistance
Achat
News

Forum | programmation
[EXCEL-VBA]
Lupin.Arsene, le jeu. 04 août 2005 à 14:57:31
Salut KdTcA,

Voici quelques observations (1er prog), celles-ci ne font pas force de loi,
c'est tout simplement ma façon de travailler. Cela pourra peut-être
te mettre sur une piste. Ces observations sont tirés de la syntaxe
du code et non sur la structure. Je me pencherai plus sur la structure
ultérieurement si besoin est...

Je répète, prend ces observations avec un grain de sel !!!


'Beaucoup de variable globale pour un si petit
'programme, certaines devraient être traduite
'en local et passer en paramètres.
Dim Chemin, Mot_Clef As String
Dim Valid, Lancement, Fin, K, Choix As Integer
Dim Ok As Boolean
Dim Cellule As Integer
Dim Cellul As String

'Lupin -> Déclaration contreversé
'Les variables utilisées avec des objets de scripting
'devrait toujours être déclaré en variant
Dim Fso, Dossier, Flder As Variant
'Lupin -> Les variables devrait toujours être typé
'même si implicite, meilleur compréhension du système
Dim Nb, Derniere_Colonne As Variant
Dim Msg1, Msg2, Style, Title, Box As Variant
Dim Fichier As Variant
'

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)
Else
If Mot = "" Then
Box = MsgBox(Msg2, Style, Title)
Else
Valid = 1
End If
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

'Lupin -> Je ne comprends pas la necessité de cette ligne
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) 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
'Lupin -> Où est définit la variable [a]???
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
'Lupin -> Où est définit la variable [i]???
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
'

Function TousLesFichiers()

'Lupin -> Où est définit la variable [fs]???
Set fs = Application.FileSearch

If Feuil2.Range("A1").Value = "" Then
Feuil2.Range("A1").Value = Dossier
Derniere_Colonne = 1
Else
Derniere_Colonne = 4
End If
'Lupin -> Où est définit la variable [F]???
For F = 1 To Derniere_Colonne
With fs
.LookIn = "" & Feuil2.Range("A" & F & "").Value & ""
.Filename = "*"
.Execute
'Lupin -> Où est définit la variable [i]???
For i = 1 To .FoundFiles.Count
If F = 1 Then
Cellul = "C"
Else
If F = 2 Then
Cellul = "D"
Else
If F = 3 Then
Cellul = "E"
Else
If F = 4 Then
Cellul = "F"
End If
End If
End If
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


Je me pencherai sur le deuxième prog ultérieurement.
Bon courage.

Lupin


PrécédentKdTcA
août 05
KdTcA
août 05
Suivant
REPONSES
Lupin.Arsene
août 05
KdTcA
août 05
Lupin.Arsene
août 05
KdTcA
août 05
KdTcA
août 05
KdTcA
août 05
KdTcA
août 05
random
août 05
KdTcA
août 05
Lupin.Arsene
août 05
Version Web
Réalisé par RedShift
no save