Discussion :

[laurent.mario]

Bonjour j'ai une macro qui fonctionne sous excel 2005 et pas 2007. J'ai lu que filesearch n'était plus implémenté sous 2007, mais quelqu'un pourrai t'il adapté mon code pour pouvoir utiliser cette macro dans les 2 versions.

merci

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

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

[ouskel'n'or]

Un coup d'oeil dans la FAQ, SilkyRoad a écrit tout un article là-dessus
Bonne lecture

[ouskel'n'or]

Edit
C'est ici

[laurent.mario]

merci pour votr lien. mais je suis débutant et je n'arrive pas a adapter mon code avec sa fonction. Par exemple comment transpoer le point .foundfile et .filename avec sa fonction ?

[ouskel'n'or]

Sans l'exemple du code que tu utilies, non, on ne peut pas
Mais avec l'exemple, sans doute qu'on peut
A+

[laurent.mario]

mon code est au début du post.

[ouskel'n'or]

mon code est au début du post.

Ce code là, je l'ai vu. Je parlais de l'adaptation du code proposé par SilkyRoad.
Bon comme je ne vois pas foule pour te répondre, je vais te proposer autre chose qui, j'espère, fonctionnera aussi bien pour ma version d'Excel (2003) que pour la tienne. Mais pour ça tu dois me dire ce que tu veux faire.
Déjà, pour vérifier l'existence d'un fichier dans un répertoire, tu peux faire

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
Sub lance()
Dim NomFich$, Chemin$
Dim Plage As Range, DerniereLigne As Long
Dim CL1 As Workbook
Dim FL1 As Worksheet
    Set CL1 = ActiveWorkbook
    Set FL1 = CL1.ActiveSheet
    Chemin = CL1.Path & "\"
    DerniereLigne = FL1.Cells(FL1.Columns(1).Cells.Count, 1).End(xlUp).Row
    Set Plage = FL1.Range("A1:A" & DerniereLigne)
    For Each Cell In Plage
        NomFich = "prix_" & Cell & ".xls"
        'NomFich = Cell & ".xls"
        NomComplet = Chemin & NomFich
        If Dir(NomComplet) <> "" Then
            Workbooks.Open Filename:=NomComplet
            'form = si tu veux créer un lien hypertexte, ce n'est pas la bonne syntaxe
          Else
            Workbooks.Open Filename:=Chemin + "prix_type.xls"
            ActiveWorkbook.SaveAs Filename:=Chemin & NomFich
            ActiveSheet.Name = Left(NomFich, Len(NomFich) - 4)
            ActiveSheet.Cells(4, 2).Formula = Mid(NomFich, 6, Len(NomFich) - 9)
            ActiveWorkbook.Save
        End If
    Next
End Sub

Pour un lien hypertexte, regarde ici... en espérant que rien n'ait changé en 2007...
Teste déjà au moins ça et dis-nous ce qu'il manque.
A+