Discussion :

[laurent.mario]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[SilkyRoad]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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.

[laurent.mario]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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