problème filesearch excel 2007

Version imprimable

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:

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:

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

29/10/2007, 14h27
ouskel'n'or

Un coup d'oeil dans la FAQ, SilkyRoad a écrit tout un article là-dessus ;)
Bonne lecture
29/10/2007, 14h29
ouskel'n'or

Edit
C'est ici
29/10/2007, 14h38
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 ?
30/10/2007, 09h37
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+
31/10/2007, 10h15
laurent.mario

mon code est au début du post.

Citation:

Envoyé par laurent.mario

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:

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+