FileSearch sous Excel 2007

Version imprimable

j'ai lu cette discussion, mais dans mon cas vos solutions ne marche pas.

J'ai une macro qui permet de créer un fichier automatiquement a partie d'un modèle si il n'existe pas. Auriez vous une solution fonctionelle sur 2007 et antérieurs ?

Merci pour vos réponses.

Code:

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
Sub lance()
 
For i = 1 To Selection.Count
ligne = Selection.Cells(i, 1).Row
nom = "prix_" + ActiveCell.Text + ".xls"
            With fs
                .Folderpath = ActiveWorkbook.Path
                .Filename = nom
                If .Execute() <> 0 Then
                If .FoundFiles(1) = ActiveWorkbook.Path + "\" + nom Then
                form = "='" + ActiveWorkbook.Path + "\[" + nom + "]prix_" + ActiveCell.Text + "'!$K$33"
                Workbooks.Open Filename:=ActiveWorkbook.Path + "\" + nom
                End If
            Else
                Workbooks.Open Filename:=ActiveWorkbook.Path + "\prix_type.xls"
                ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + nom
                Mid(nom, Len(nom) - 3, 4) = "    "
                ActiveSheet.Name = RTrim(nom)
                ActiveSheet.Cells(4, 2).Formula = Right(nom, Len(nom) - 5)
                ActiveWorkbook.Save
            End If
            End With
Next
End Sub
Sub imprime()
Set fs = ClFileSearch.ClasseFileSearch
For i = 1 To Selection.Count
ligne = Selection.Cells(i, 1).Row
nom = "prix_" + ActiveCell.Text + ".xls"
            With fs
                .LookIn = ActiveWorkbook.Path
                .Filename = nom
                .MatchTextExactly = True
            If .Execute() = 1 Then
                If .FoundFiles(1) = ActiveWorkbook.Path + "\" + nom Then
                form = "='" + ActiveWorkbook.Path + "\[" + nom + "]prix_" + ActiveCell.Text + "'!$K$33"
                Workbooks.Open Filename:=ActiveWorkbook.Path + "\" + nom
                ActiveWorkbook.ActiveSheet.PrintOut
                ActiveWorkbook.Saved = True
                ActiveWorkbook.Close
                End If
            End If
            End With
Next
End Sub

bonsoir Laurent

Relit le tutoriel. Tu confonds l'objet FileSearch et le complément, dans la syntaxe de ta procédure.

un exemple simple à adapter à ta macro:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim Fs As ClFileSearch.ClasseFileSearch
Dim i As Long
Dim Fichier As String, Chemin As String
Dim Wb As Workbook
 
Set Fs = ClFileSearch.Nouvelle_Recherche
Chemin = ActiveWorkbook.Path
 
With Fs
    .FolderPath = Chemin
    .SubFolders = False
    '.SortBy = sort_Name
    .Extension = "*NomClasseur.xls"
    .Execute
 
    For i = 1 To .FoundFilesCount
        Set Wb = Workbooks.Open(Chemin & "\" & .Files(i).strFileName)
        '
        'Action dans le(s) classeur(s)
        '
        Wb.Close (False)
    Next i
 
End With

bonne soirée
michel

22/10/2007, 18h56
laurent.mario

je suis débuttant et je ne comprend pas tous votre procédure. Je vais essayer mais tous vos conseils me seront utile.

la copie de mon code est erroné, elle comprend deja un essai de modi. Je vous rejoint mon code d'origine fonctionnel sous excel 2003

Code:

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
Sub lance()
Dim i As Long
For i = 1 To Selection.Count
ligne = Selection.Cells(i, 1).Row
nom = "prix_" + ActiveCell.Text + ".xls"
            With Application.FileSearch
                .LookIn = ActiveWorkbook.Path
                .Filename = nom
                .MatchTextExactly = True
                 If .Execute() <> 0 Then
                    If .FoundFiles(1) = ActiveWorkbook.Path + "\" + nom Then
                    form = "='" + ActiveWorkbook.Path + "\[" + nom + "]prix_" + ActiveCell.Text + "'!$K$33"
                    Workbooks.Open Filename:=ActiveWorkbook.Path + "\" + nom
                    End If
                Else
                    Workbooks.Open Filename:=ActiveWorkbook.Path + "\prix_type.xls"
                    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + "\" + nom
                    Mid(nom, Len(nom) - 3, 4) = "    "
                    ActiveSheet.Name = RTrim(nom)
                    ActiveSheet.Cells(4, 2).Formula = Right(nom, Len(nom) - 5)
                    ActiveWorkbook.Save
                End If
            End With
Next
End Sub
Sub imprime()
'
For i = 1 To Selection.Count
ligne = Selection.Cells(i, 1).Row
nom = "prix_" + ActiveCell.Text + ".xls"
            With Application.FileSearch
                .LookIn = ActiveWorkbook.Path
                .Filename = nom
                .MatchTextExactly = True
            If .Execute() = 1 Then
                If .FoundFiles(1) = ActiveWorkbook.Path + "\" + nom Then
                form = "='" + ActiveWorkbook.Path + "\[" + nom + "]prix_" + ActiveCell.Text + "'!$K$33"
                Workbooks.Open Filename:=ActiveWorkbook.Path + "\" + nom
                ActiveWorkbook.ActiveSheet.PrintOut
                ActiveWorkbook.Saved = True
                ActiveWorkbook.Close
                End If
            End If
            End With
Next
End Sub