Ouvrir un formulaire situé dans un répertoire

Re,

Ci-dessous ton code "corrigé". Je ne peux évidemment tester. J'ai
seulement essayé de rendre le déroulement de la procédure plus cohérent.
Par exemple, tu n'as pas besoin de passer la valeur de J4 en paramètre
puisque le code va la chercher à la ligne
AChercher = Range("J4").Text
Ça te permet de déclencher cette macro en la reliant à un bouton de
barre d'outils sans 'ligne de commande' compliquée.
Bon,
teste et dis-moi.

'============================ Sub RéouvreDevis1page_v2()
'je fais appel à cette procédure depuis la cellule J4
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value

Dim Ctr As Integer, Plage As Range, c As Range

'===================
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$
Dim Feuille As Worksheet

7 AChercher = Range("J4").Text 'modif ici
8 NomDossier = "C:CONCEPT HabitatDevis"
9 Ctr = 21 'rajouté
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set Dossier = fso.getfolder(NomDossier)
12 Set Files = Dossier.Files
13 If Files.Count <> 0 Then
14 For Each File In Files
15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
16 Workbooks.Open NomDossier & File.Name
Set Feuille = Workbooks(File.Name).ActiveSheet 'modif
Exit For
End If
Next
End If

18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
'(rajouté)
20 .Range("num_client") = Feuille.Range("num_client")
21 .Range("dnomcli1") = Feuille.Range("dnomcli1")
22 .Range("numdevis1") = Feuille.Range("numdevis1")
23 .Range("frue1") = Feuille.Range("frue1")
24 .Range("frue2") = Feuille.Range("frue2")
25 .Range("fville") = Feuille.Range("fville")
26 .Range("fcp") = Feuille.Range("fcp")
27 .Range("téléphone") = Feuille.Range("téléphone")
28 .Range("portable") = Feuille.Range("portable")
29 .Range("fremise") = Feuille.Range("dremise")
30 .Range("B17") = Feuille.Range("B17")
31 .Range("H4") = Feuille.Range("H4")
32 .Range("H5") = Feuille.Range("H5")
33 .Range("I51") = Feuille.Range("I51")
34 Set Plage = Feuille.Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(File.Name).Close False
44 ActiveSheet.Protect
45 End With

End Sub
'============================
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Bonjour FS

J'ai essayé d'adapter ta solution dans mon code, sans succé non que ça ne
fonctionne pas, au contraire ça m'ouvre bien le devis, mais il n'est pas
retranscrit dans le formulaire appelant.
Si tu veux bien encore m'aider, voila ce que j'ai fais
sans grand succé.

Sub RéouvreDevis1page(Fich) 'je fais appel à cette procédure depuis la
cellule J4
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value
Dim Ctr As Integer, Plage As Range, c As Range

'=================== >
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$
7 AChercher = Range("J4").Text 'modif ici
8 NomDossier = "C:CONCEPT HabitatDevis"
9 Ctr = 21 'rajouté
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set Dossier = fso.getfolder(NomDossier)
12 Set Files = Dossier.Files
13 If Files.Count <> 0 Then
14 For Each File In Files
15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
16 Workbooks.Open NomDossier & File.Name
17 Feuille = ActiveSheet.Name ' rajouté
18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page") '
rajouté
19 Exit For
'Ctr = 21
'Feuille = ActiveSheet.Name
'With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
20 .Range("num_client") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client")
21 .Range("dnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
22 .Range("numdevis1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("numdevis1")
23 .Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
24 .Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
25 .Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
26 .Range("fcp") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("fcp")
27 .Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
28 .Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
29 .Range("fremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
30 .Range("B17") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("B17")
31 .Range("H4") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H4")
32 .Range("H5") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H5")
33 .Range("I51") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("I51")
34 Set Plage = Workbooks(Fich & ".xls").Sheets(Feuille).Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(Fich & ".xls").Close False
44 ActiveSheet.Protect
45 End With
46 End If
47 Next
48 End If
End Sub

Quand je rappele un Devis en F4, je vais le chercher dans le dossier ou il
est rangé,
et je le met en place dans le formulaire qui la créé, pour pouvoir ètre
modifier
(rajout de travaux ou autre) et je le reenregistre de nouveau.
C'est ce que je voudrais arriver en faire en tenant compte du nouveau format
de N° de Devis.

"FS" a écrit :

Bonjour,

Si tu ne modifies pas tout ton projet comme suggéré par Jac, le code
ci-dessous corrige le précedent en recherchant le numéro saisi en
cellule J4. Il faut que le format de cette cellule soit personnalisé
(0000000) pour qu'un zéro initial soit pris en compte (la propriété Text
de la cellule permet de prendre en compte son contenu affiché).
Si le code n'est pas lancé depuis le classeur qui contient la cellule J4
et que la feuille qui contient cette même cellule n'est pas la feuille
active, il faudra qualifier entièrement le chemin d'accès à J4 (par
exemple :

AChercher =
Workbooks("leclasseur.xls").sheets("lafeuille").Range("J4").Text)

'=================== >> Sub OuvreDevis_2()
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$

AChercher = Range("J4").Text 'modif ici
NomDossier = "C:CONCEPT HabitatDevis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
Workbooks.Open NomDossier & File.Name
Exit For
End If
Next
End If

End Sub
'=================== >>
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Re

J'ai oublié de présiser que dans mon formulaire
je rentre le N° de devis à rechercher dans une cellule en J4
Merci encore et bonne soirée.
Peponne31

"FS" a écrit :

Bonsoir,

Une approche légèrement différente de celle de Denis :

'=================== >>>> Sub OuvreDevis()
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$

AChercher = _
Format(InputBox("Saisir le numéro du devis à ouvrir"), "0000000")
NomDossier = "C:CONCEPT HabitatDevis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
Workbooks.Open NomDossier & File.Name
Exit For
End If
Next
End If

End Sub
'=================== >>>>
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Bonjour,

Je voudrais ouvrir un formulaire enregistré dans un répetoire.
Ce formulaire est un devis que je veux transformer en facture.
Mes devis sont enregistrés enregistré comme suit: "Mme & M. DURAND 0909012"
ou bien "M. DUCHEMIN 0909013" et je voudrais l'ouvrir en ne me servant que de
son N° pour le rappeler: "0909012".
J'ai commencé un bout de code mais ne sais pas le terminer, pas assé
compétant.

Private Sub OuvreDevis()
Dim Chemin As String
Dim Feuille As String
Chemin = "C:CONCEPT HabitatDevis"
Workbooks.Open Chemin & Fich & ".xls"
End Sub

Si qulqu'un peux m'aider ce serai avec grand plaisir.Peponne31

Re,

j'ai essayé ta modification elle m'ouvre toujours le devis dans un autre
classeur et non dans le formulaire. J'ai bien essayé de corriger mais sans
succé.Je me permet de te mètre le code original qui lui fonctionne bien, il
me prend les 6 chiffres du devis et s'ouvre dans le formulaire. Si tu peux
(et si tu as du temps à me consacrer) me le modifier pour qu'il prenne en
compte le nom du client devant les 6 chiffres, pour le reste tout est OK à
part la gestion d'erreur qui est à revoir.

Private Sub Worksheet_Change(ByVal Target As Range)
1 Application.ScreenUpdating = False
2 If Target.Address = "$J$6" Then
3 ValideSaisie '** ici, je rentre un client sur page vierge
4 ActiveSheet.Unprotect
5 LectureDeJ6
6 EcritureDeB10
7 ActiveSheet.Protect
8 Feuille = ActiveSheet.Name
9 ElseIf Target.Address = "$J$3" Then
10 RéouvreDevis1page Target.Value '** ici je rappele un devis
11 ActiveSheet.Unprotect
12 MaValeurDeB10
13 MaValeurDeJ6
14 ActiveSheet.Protect
15 End If
End Sub
Sub RéouvreDevis1page(Fich)
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value
Dim Chemin As String, Ctr As Integer, Plage As Range, c As Range
7 Chemin = "C:CONCEPT Habitatdevis"
8 Ctr = 21
9 Err = 0
10 On Error Resume Next
11 Workbooks.Open Chemin & Fich & ".xls"
12 If Err = 1004 Then 'Permet de contrôler si un N° de devis existe.
13 zz_Clignote2
14 Message = MsgBox("Ce N° de devis n'existe pas !", , "CONCEPT
Habitat")
15 Range("B10,B11,J3").Select
16 Selection.ClearContents
17 Range("J3").Activate
18 End If
19 Feuille = ActiveSheet.Name
20 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
21 .Range("num_client1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client1")
22 .Range("fnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
23 .Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
24 .Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
25 .Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
26 .Range("fcp") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fcp")
27 .Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
28 .Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
29 .Range("dremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
30 .Range("B17") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("B17")
31 .Range("H4") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("H4")
32 .Range("H5") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("H5")
33 .Range("I51") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("I51")
34 Set Plage = Workbooks(Fich &
".xls").Sheets(Feuille).Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(Fich & ".xls").Close False
44 ActiveSheet.Protect
45 End With
End Sub

je vous remercie encore pour le temps que vous me consacrer.
Peponne31

"FS" a écrit :

Re,

Ci-dessous ton code "corrigé". Je ne peux évidemment tester. J'ai
seulement essayé de rendre le déroulement de la procédure plus cohérent.
Par exemple, tu n'as pas besoin de passer la valeur de J4 en paramètre
puisque le code va la chercher à la ligne
AChercher = Range("J4").Text
Ça te permet de déclencher cette macro en la reliant à un bouton de
barre d'outils sans 'ligne de commande' compliquée.
Bon,
teste et dis-moi.

'============================ > Sub RéouvreDevis1page_v2()
'je fais appel à cette procédure depuis la cellule J4
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value

Dim Ctr As Integer, Plage As Range, c As Range

'=================== >
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$
Dim Feuille As Worksheet

7 AChercher = Range("J4").Text 'modif ici
8 NomDossier = "C:CONCEPT HabitatDevis"
9 Ctr = 21 'rajouté
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set Dossier = fso.getfolder(NomDossier)
12 Set Files = Dossier.Files
13 If Files.Count <> 0 Then
14 For Each File In Files
15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
16 Workbooks.Open NomDossier & File.Name
Set Feuille = Workbooks(File.Name).ActiveSheet 'modif
Exit For
End If
Next
End If

18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
'(rajouté)
20 .Range("num_client") = Feuille.Range("num_client")
21 .Range("dnomcli1") = Feuille.Range("dnomcli1")
22 .Range("numdevis1") = Feuille.Range("numdevis1")
23 .Range("frue1") = Feuille.Range("frue1")
24 .Range("frue2") = Feuille.Range("frue2")
25 .Range("fville") = Feuille.Range("fville")
26 .Range("fcp") = Feuille.Range("fcp")
27 .Range("téléphone") = Feuille.Range("téléphone")
28 .Range("portable") = Feuille.Range("portable")
29 .Range("fremise") = Feuille.Range("dremise")
30 .Range("B17") = Feuille.Range("B17")
31 .Range("H4") = Feuille.Range("H4")
32 .Range("H5") = Feuille.Range("H5")
33 .Range("I51") = Feuille.Range("I51")
34 Set Plage = Feuille.Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(File.Name).Close False
44 ActiveSheet.Protect
45 End With

End Sub
'============================ >
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :
> Bonjour FS
>
> J'ai essayé d'adapter ta solution dans mon code, sans succé non que ça ne
> fonctionne pas, au contraire ça m'ouvre bien le devis, mais il n'est pas
> retranscrit dans le formulaire appelant.
> Si tu veux bien encore m'aider, voila ce que j'ai fais
> sans grand succé.
>
> Sub RéouvreDevis1page(Fich) 'je fais appel à cette procédure depuis la
> cellule J4
> 1 ActiveSheet.Unprotect
> 2 Range("I12").Select
> 3 ActiveCell.FormulaR1C1 = "=TODAY()"
> 4 ActiveCell.Value = ActiveCell.Value
> 5 Range("date").Select
> 6 ActiveCell.Value = ActiveCell.Value
> Dim Ctr As Integer, Plage As Range, c As Range
>
> '=================== > >
> Dim fso As Object, Dossier As Object, NomDossier$
> Dim Files As Object, File As Object, AChercher$
> 7 AChercher = Range("J4").Text 'modif ici
> 8 NomDossier = "C:CONCEPT HabitatDevis"
> 9 Ctr = 21 'rajouté
> 10 Set fso = CreateObject("Scripting.FileSystemObject")
> 11 Set Dossier = fso.getfolder(NomDossier)
> 12 Set Files = Dossier.Files
> 13 If Files.Count <> 0 Then
> 14 For Each File In Files
> 15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
> 16 Workbooks.Open NomDossier & File.Name
> 17 Feuille = ActiveSheet.Name ' rajouté
> 18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page") '
> rajouté
> 19 Exit For
> 'Ctr = 21
> 'Feuille = ActiveSheet.Name
> 'With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
> 20 .Range("num_client") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("num_client")
> 21 .Range("dnomcli1") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("dnomcli1")
> 22 .Range("numdevis1") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("numdevis1")
> 23 .Range("frue1") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("frue1")
> 24 .Range("frue2") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("frue2")
> 25 .Range("fville") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("fville")
> 26 .Range("fcp") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("fcp")
> 27 .Range("téléphone") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("téléphone")
> 28 .Range("portable") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("portable")
> 29 .Range("fremise") = Workbooks(Fich &
> ".xls").Sheets(Feuille).Range("dremise")
> 30 .Range("B17") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("B17")
> 31 .Range("H4") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H4")
> 32 .Range("H5") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H5")
> 33 .Range("I51") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("I51")
> 34 Set Plage = Workbooks(Fich & ".xls").Sheets(Feuille).Range("A21:A50")
> 35 For Each c In Plage
> 36 .Range("A" & Ctr) = c.Value
> 37 .Range("F" & Ctr) = c.Offset(0, 1)
> 38 .Range("G" & Ctr) = c.Offset(0, 2)
> 39 .Range("H" & Ctr) = c.Offset(0, 3)
> 40 .Range("J" & Ctr) = c.Offset(0, 5)
> 41 Ctr = Ctr + 1
> 42 Next c
> 43 Workbooks(Fich & ".xls").Close False
> 44 ActiveSheet.Protect
> 45 End With
> 46 End If
> 47 Next
> 48 End If
> End Sub
>
> Quand je rappele un Devis en F4, je vais le chercher dans le dossier ou il
> est rangé,
> et je le met en place dans le formulaire qui la créé, pour pouvoir ètre
> modifier
> (rajout de travaux ou autre) et je le reenregistre de nouveau.
> C'est ce que je voudrais arriver en faire en tenant compte du nouveau format
> de N° de Devis.
>
> "FS" a écrit :
>
>> Bonjour,
>>
>> Si tu ne modifies pas tout ton projet comme suggéré par Jac, le code
>> ci-dessous corrige le précedent en recherchant le numéro saisi en
>> cellule J4. Il faut que le format de cette cellule soit personnalisé
>> (0000000) pour qu'un zéro initial soit pris en compte (la propriété Text
>> de la cellule permet de prendre en compte son contenu affiché).
>> Si le code n'est pas lancé depuis le classeur qui contient la cellule J4
>> et que la feuille qui contient cette même cellule n'est pas la feuille
>> active, il faudra qualifier entièrement le chemin d'accès à J4 (par
>> exemple :
>>
>> AChercher =
>> Workbooks("leclasseur.xls").sheets("lafeuille").Range("J4").Text)
>>
>> '=================== > >> Sub OuvreDevis_2()
>> Dim fso As Object, Dossier As Object, NomDossier$
>> Dim Files As Object, File As Object, AChercher$
>>
>> AChercher = Range("J4").Text 'modif ici
>> NomDossier = "C:CONCEPT HabitatDevis"
>> Set fso = CreateObject("Scripting.FileSystemObject")
>> Set Dossier = fso.getfolder(NomDossier)
>> Set Files = Dossier.Files
>> If Files.Count <> 0 Then
>> For Each File In Files
>> If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
>> Workbooks.Open NomDossier & File.Name
>> Exit For
>> End If
>> Next
>> End If
>>
>> End Sub
>> '=================== > >>
>> FS
>> --
>> Frédéric SIGONNEAU
>> Modules et modèles pour Excel :
>> http://frederic.sigonneau.free.fr/
>>
>> Peponne31 a écrit :
>>> Re
>>>
>>> J'ai oublié de présiser que dans mon formulaire
>>> je rentre le N° de devis à rechercher dans une cellule en J4
>>> Merci encore et bonne soirée.
>>> Peponne31
>>>
>>> "FS" a écrit :
>>>
>>>> Bonsoir,
>>>>
>>>> Une approche légèrement différente de celle de Denis :
>>>>
>>>> '=================== > >>>> Sub OuvreDevis()
>>>> Dim fso As Object, Dossier As Object, NomDossier$
>>>> Dim Files As Object, File As Object, AChercher$
>>>>
>>>> AChercher = _
>>>> Format(InputBox("Saisir le numéro du devis à ouvrir"), "0000000")
>>>> NomDossier = "C:CONCEPT HabitatDevis"
>>>> Set fso = CreateObject("Scripting.FileSystemObject")
>>>> Set Dossier = fso.getfolder(NomDossier)
>>>> Set Files = Dossier.Files
>>>> If Files.Count <> 0 Then
>>>> For Each File In Files
>>>> If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
>>>> Workbooks.Open NomDossier & File.Name
>>>> Exit For
>>>> End If
>>>> Next
>>>> End If
>>>>
>>>> End Sub
>>>> '=================== > >>>>
>>>> FS
>>>> --
>>>> Frédéric SIGONNEAU
>>>> Modules et modèles pour Excel :
>>>> http://frederic.sigonneau.free.fr/
>>>>
>>>> Peponne31 a écrit :
>>>>> Bonjour,
>>>>>
>>>>> Je voudrais ouvrir un formulaire enregistré dans un répetoire.
>>>>> Ce formulaire est un devis que je veux transformer en facture.
>>>>> Mes devis sont enregistrés enregistré comme suit: "Mme & M. DURAND 0909012"
>>>>> ou bien "M. DUCHEMIN 0909013" et je voudrais l'ouvrir en ne me servant que de
>>>>> son N° pour le rappeler: "0909012".
>>>>> J'ai commencé un bout de code mais ne sais pas le terminer, pas assé
>>>>> compétant.
>>>>>
>>>>> Private Sub OuvreDevis()
>>>>> Dim Chemin As String
>>>>> Dim Feuille As String
>>>>> Chemin = "C:CONCEPT HabitatDevis"
>>>>> Workbooks.Open Chemin & Fich & ".xls"
>>>>> End Sub
>>>>>
>>>>> Si qulqu'un peux m'aider ce serai avec grand plaisir.Peponne31

... je n'ai aucune expérience en Visual Studio... Pour moi, c'est du ni
vu ni connu. Je ne sais pas comment ça marche ni ce qu'on peut faire
avec. Mais s'il faut tout réinventer, j'espère que tu connais bien ce
produit, si non, c'est refaire en découvrant autre chose, avec d'autres
problèmes à résoudre en cours de route.

Tu dis programme autonome qui pourra évoluer...
Bonne idée, mais si tu n'es pas là, qui peut faire quelque chose ?

Mais c'est peut-être plus facile de trouver quelqu'un pour poursuivre
dans Excel plutôt que dans Visual quelque chose version x, y ou z, non
?

J'ai développé une gestion de salle de remise en forme. La question du
choix des outils se posait entre Excel et Access et j'ai opté pour
Excel avec dans l'idée qu'on trouve plus faiclement des ressources dans
Excel que dans Access. Pose la question autour de toi et compte ceux
qui connaissent (ou prétendent) les produits.
C'est sûr que si je veux que l'on ait toujours besoin de moi ce n'est
pas le bon choix. Mais si demain je suis hors circuit, qui fera évoluer
le produit ? Et à quel prix ?

----------------------------------------------------------------------

Mais je ne dis pas de tout recommencer, je dis juste, par expérience,
que parfois, il faut s'arrêter un peu pour regarder les choses avec un
oeil neuf, avec une démarche cohérente pour améliorer le fonctionnement
de la "chose". La question à ne jamais perdre de vue est : "Est-ce que
quelqu'un d'autre que moi pourrait faire marcher, du jour au lendemain,
cette usine à gaz dont on ne voit que le portail d'entrée ?" Car on a
toujours quelques manipulations extrèmement rapides avec des raccourcis
clavier qui font pâlir les autres, mais de là à leur faire faire... il
y a tout un monde.

J'ai en tête une secrétaire dans une entreprise qui faisait des
factures dans word en publipostage pour "trouver" les destinataires et
en tableau Word pour le corps de facture. A ma question "Et si ton
patron te demandait combien a été facturé au 1° semestre ?" elle m'a
avoué que c'était arrivé et qu'elle avait mis trois semaines pour
sortir des résultats. Heureusement qu'il ne lui a pas demandé des
totaux par client ou par pays... ou payés, ou ...

Pour tes devis dans de multiples fichiers, tu peux sortir un listing ou
des chiffres ?
Combien depuis le début de l'année ? Quel chiffre d'affaire envisagé ?
Combien de devis sans suite depuis plus de 3 mois ?
Avec une date de début de travaux ou de livraison envisagée :
Quel CA prévisionnel pour les mois à venir ?
Liste des client à relancer ?
Liste des devis devenus commande ferme ? Liste des accomptes ?

On en reparle quand tu veux, même au téléphone si tu veux.



Peponne31 a formulé ce vendredi :

Bonjour jac,

Ce que tu me dit c'est de tout recommencer,
c'est une idée qui me trote depuis un moment
mais à refaire je pense utiliser Visual Studio
de manière à concevoir un petit programme autonome
sous windows qui pourra évoluer au fil du temps.
Quand pense-tu ?
Peponne31



"Jac" a écrit :

Bonjour Peponne31,

si je comprends bien, tu as un classeur pour chaque devis, et je
suppose un classeur pour chaque facture. Et tu fais du vba.
Moi, je pencherait plutôt pour une autre solution : un seul classeur.

Imaginons :

1-une feuille SAISIE organisée sans préoccupation de l'impression,
c'est à dire organisée pour bien voir et bien saisir, entre autre, avec
une liste des prestations, leur prix unitaire, et une colonne quantité
(+ catégorie, + brut ht, + taux de tva si nécessaire, + ...), bref,
tout ce qu'il faut pour se faciliter la vie, et pour afficher le
résultat total, avec éventuellement quelques coefficients pour adapter
les prix (par quantité, tête du client ou pour arriver à un total prévu
ou "rond").
Ne seront retenues, grâce à un filtre automatique, que les lignes avec
une quantité non vide.

2-une feuille TRANSFERT, automatique (éventuellement masquée) qui sera
alimentée par macro, à la demande par ce qui est visible dans la
feuille SAISIE car grâce à un filtre automatique, seules les lignes
avec une quantité non vide seront visibles.

3-une feuille TEMPORAIRE, automatique (éventuellement masquée)
reprendra par calcul, sur une seule ligne, toutes les données de la
feuille TRANSFERT avec éventuellement quelques champs calculés pour
faciliter le travail de base de données avec filtre automatique (année,
mois [200909], ...) et quelques champs vides (payé le, à relancer,
nbjours depuis facture, ...), bref les champs à remplir ultérieurement.

4-une feuille FACTURES_DEVIS qui sera une base de données qui reprendra
pour chaque facture ou devis la ligne de la feuille temporaire. Avec
les titres qui vont bien, et un ordre de colonnes judicieux, aucun
problème pour filtrer le devis n° ou le client Schmurtz et voir toutes
ses factures et tous ses devis.

5-une feuille PREP_IMPRESSION, automatique (éventuellement masquée)
dans laquelle on ira coller la ligne de la facture ou du devis à
imprimer

6-une feuille IMPRESSION alimentée par calcul sur la feuille
PREP_IMPRESSION qui aura le bon look pour présenter ce qu'il y a à
imprimer. Si nécessaire une autre feuille permettra d'imprimer factures
ou devis sur plusieurs pages.

7-quelques macros pour faire la gymnastique nécessaire.

On en reparle quand tu veux.

Jac


Peponne31 avait prétendu :

Bonjour,

Je voudrais ouvrir un formulaire enregistré dans un répetoire.
Ce formulaire est un devis que je veux transformer en facture.
Mes devis sont enregistrés enregistré comme suit: "Mme & M. DURAND 0909012"
ou bien "M. DUCHEMIN 0909013" et je voudrais l'ouvrir en ne me servant que
de son N° pour le rappeler: "0909012".
J'ai commencé un bout de code mais ne sais pas le terminer, pas assé
compétant.

Private Sub OuvreDevis()
Dim Chemin As String
Dim Feuille As String
Chemin = "C:CONCEPT HabitatDevis"
Workbooks.Open Chemin & Fich & ".xls"
End Sub

Si qulqu'un peux m'aider ce serai avec grand plaisir.Peponne31

... je ne cherche pas à rentrer dans les problèmes de tes macros,
d'autres s'y sont collés.

Mais si j'essaye de récapituler :

1- tu as X devis.xls
2- tu veux "remonter" le devis_Y.xls dans ton formulaire_de_saisie.xls
afin de l'éditer.

Solution :

1- dans ton formulaire_de_saisie.xls tu rajoutes une feuille "RECUP"
2- tu ouvres le devis_Y.xls
3- tu sélectionnes et copies les données
4- tu colles seulement les valeurs des variables dans "RECUP" en A1

Donc à chaque fois que tu veux reprendre un devis tu récupères les
variables dans les même cellules, sauf si chaque devis a ses variables
dans des cellules différentes... Bonjour la salade (de devis).

5- tu renvoies toutes tes variables dans ton formulaire. Deux façons
possibles par macro :
-de façon directe (boucle(s), variables multivaluées, ...) en prenant
chaque variable dans "RECUP" et en la collant dans le formulaire. C'est
lour et peu souple.
- de façon indirecte en utilisant une feuille "TEMP" qui a la même
structure que le formulaire, mais qui récupère les données dans les
bonnes cases par calcul depuis la feuille "RECUP" puis la macro
sélectionne, copie et colle seulement les valeurs dans le formulaire.

Donc ton devis Y est dans ton formulaire et quand tu auras fini de le
triturer, tu pourras générer à nouveau le devis_Y.xls ou le
devis_Y2.xls

La macro de la façon indirecte est simple à mettre en oeuvre, même sans
le forum.

Pourquoi pas ?

------------------------------

Le grand défaut des utilisateurs, c'est que pour faire un devis ou une
facture, ils travaillent en général dans la feuille qui leur sert à
l'impression. Donc une facture = 1 fichier XL (ou Word...) ou une
feuile dans un classeur XL.

Est-ce raisonnable ? Sans doute. Mais s'il faut générer : listing des
factures du mois, du trimestre, de l'année, des payés et des impayés,
par client, pays, département ou banque, des relances à faire, ...
est-ce vraiment raisonnable ?

C'est sur que l'on peut alimenter un nouveau tableau sans risque
d'erreur (bien sûr...) et obtenir ces résultats. Mais avant de faire le
travail deux fois, il peut être judicieux de revoir la façon de faire.

Désolé Peponne31. Je ne peux rien faire de mieux.

FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Re,

j'ai essayé ta modification elle m'ouvre toujours le devis dans un autre
classeur et non dans le formulaire. J'ai bien essayé de corriger mais sans
succé.Je me permet de te mètre le code original qui lui fonctionne bien, il
me prend les 6 chiffres du devis et s'ouvre dans le formulaire. Si tu peux
(et si tu as du temps à me consacrer) me le modifier pour qu'il prenne en
compte le nom du client devant les 6 chiffres, pour le reste tout est OK à
part la gestion d'erreur qui est à revoir.

Private Sub Worksheet_Change(ByVal Target As Range)
1 Application.ScreenUpdating = False
2 If Target.Address = "$J$6" Then
3 ValideSaisie '** ici, je rentre un client sur page vierge
4 ActiveSheet.Unprotect
5 LectureDeJ6
6 EcritureDeB10
7 ActiveSheet.Protect
8 Feuille = ActiveSheet.Name
9 ElseIf Target.Address = "$J$3" Then
10 RéouvreDevis1page Target.Value '** ici je rappele un devis
11 ActiveSheet.Unprotect
12 MaValeurDeB10
13 MaValeurDeJ6
14 ActiveSheet.Protect
15 End If
End Sub
Sub RéouvreDevis1page(Fich)
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value
Dim Chemin As String, Ctr As Integer, Plage As Range, c As Range
7 Chemin = "C:CONCEPT Habitatdevis"
8 Ctr = 21
9 Err = 0
10 On Error Resume Next
11 Workbooks.Open Chemin & Fich & ".xls"
12 If Err = 1004 Then 'Permet de contrôler si un N° de devis existe.
13 zz_Clignote2
14 Message = MsgBox("Ce N° de devis n'existe pas !", , "CONCEPT
Habitat")
15 Range("B10,B11,J3").Select
16 Selection.ClearContents
17 Range("J3").Activate
18 End If
19 Feuille = ActiveSheet.Name
20 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
21 .Range("num_client1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client1")
22 .Range("fnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
23 .Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
24 .Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
25 .Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
26 .Range("fcp") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fcp")
27 .Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
28 .Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
29 .Range("dremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
30 .Range("B17") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("B17")
31 .Range("H4") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("H4")
32 .Range("H5") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("H5")
33 .Range("I51") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("I51")
34 Set Plage = Workbooks(Fich &
".xls").Sheets(Feuille).Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(Fich & ".xls").Close False
44 ActiveSheet.Protect
45 End With
End Sub

je vous remercie encore pour le temps que vous me consacrer.
Peponne31

"FS" a écrit :

Re,

Ci-dessous ton code "corrigé". Je ne peux évidemment tester. J'ai
seulement essayé de rendre le déroulement de la procédure plus cohérent.
Par exemple, tu n'as pas besoin de passer la valeur de J4 en paramètre
puisque le code va la chercher à la ligne
AChercher = Range("J4").Text
Ça te permet de déclencher cette macro en la reliant à un bouton de
barre d'outils sans 'ligne de commande' compliquée.
Bon,
teste et dis-moi.

'============================ >> Sub RéouvreDevis1page_v2()
'je fais appel à cette procédure depuis la cellule J4
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value

Dim Ctr As Integer, Plage As Range, c As Range

'=================== >>
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$
Dim Feuille As Worksheet

7 AChercher = Range("J4").Text 'modif ici
8 NomDossier = "C:CONCEPT HabitatDevis"
9 Ctr = 21 'rajouté
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set Dossier = fso.getfolder(NomDossier)
12 Set Files = Dossier.Files
13 If Files.Count <> 0 Then
14 For Each File In Files
15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
16 Workbooks.Open NomDossier & File.Name
Set Feuille = Workbooks(File.Name).ActiveSheet 'modif
Exit For
End If
Next
End If

18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
'(rajouté)
20 .Range("num_client") = Feuille.Range("num_client")
21 .Range("dnomcli1") = Feuille.Range("dnomcli1")
22 .Range("numdevis1") = Feuille.Range("numdevis1")
23 .Range("frue1") = Feuille.Range("frue1")
24 .Range("frue2") = Feuille.Range("frue2")
25 .Range("fville") = Feuille.Range("fville")
26 .Range("fcp") = Feuille.Range("fcp")
27 .Range("téléphone") = Feuille.Range("téléphone")
28 .Range("portable") = Feuille.Range("portable")
29 .Range("fremise") = Feuille.Range("dremise")
30 .Range("B17") = Feuille.Range("B17")
31 .Range("H4") = Feuille.Range("H4")
32 .Range("H5") = Feuille.Range("H5")
33 .Range("I51") = Feuille.Range("I51")
34 Set Plage = Feuille.Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(File.Name).Close False
44 ActiveSheet.Protect
45 End With

End Sub
'============================ >>
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Bonjour FS

J'ai essayé d'adapter ta solution dans mon code, sans succé non que ça ne
fonctionne pas, au contraire ça m'ouvre bien le devis, mais il n'est pas
retranscrit dans le formulaire appelant.
Si tu veux bien encore m'aider, voila ce que j'ai fais
sans grand succé.

Sub RéouvreDevis1page(Fich) 'je fais appel à cette procédure depuis la
cellule J4
1 ActiveSheet.Unprotect
2 Range("I12").Select
3 ActiveCell.FormulaR1C1 = "=TODAY()"
4 ActiveCell.Value = ActiveCell.Value
5 Range("date").Select
6 ActiveCell.Value = ActiveCell.Value
Dim Ctr As Integer, Plage As Range, c As Range

'=================== >>>
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$
7 AChercher = Range("J4").Text 'modif ici
8 NomDossier = "C:CONCEPT HabitatDevis"
9 Ctr = 21 'rajouté
10 Set fso = CreateObject("Scripting.FileSystemObject")
11 Set Dossier = fso.getfolder(NomDossier)
12 Set Files = Dossier.Files
13 If Files.Count <> 0 Then
14 For Each File In Files
15 If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
16 Workbooks.Open NomDossier & File.Name
17 Feuille = ActiveSheet.Name ' rajouté
18 With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page") '
rajouté
19 Exit For
'Ctr = 21
'Feuille = ActiveSheet.Name
'With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
20 .Range("num_client") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client")
21 .Range("dnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
22 .Range("numdevis1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("numdevis1")
23 .Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
24 .Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
25 .Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
26 .Range("fcp") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("fcp")
27 .Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
28 .Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
29 .Range("fremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
30 .Range("B17") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("B17")
31 .Range("H4") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H4")
32 .Range("H5") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H5")
33 .Range("I51") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("I51")
34 Set Plage = Workbooks(Fich & ".xls").Sheets(Feuille).Range("A21:A50")
35 For Each c In Plage
36 .Range("A" & Ctr) = c.Value
37 .Range("F" & Ctr) = c.Offset(0, 1)
38 .Range("G" & Ctr) = c.Offset(0, 2)
39 .Range("H" & Ctr) = c.Offset(0, 3)
40 .Range("J" & Ctr) = c.Offset(0, 5)
41 Ctr = Ctr + 1
42 Next c
43 Workbooks(Fich & ".xls").Close False
44 ActiveSheet.Protect
45 End With
46 End If
47 Next
48 End If
End Sub

Quand je rappele un Devis en F4, je vais le chercher dans le dossier ou il
est rangé,
et je le met en place dans le formulaire qui la créé, pour pouvoir ètre
modifier
(rajout de travaux ou autre) et je le reenregistre de nouveau.
C'est ce que je voudrais arriver en faire en tenant compte du nouveau format
de N° de Devis.

"FS" a écrit :

Bonjour,

Si tu ne modifies pas tout ton projet comme suggéré par Jac, le code
ci-dessous corrige le précedent en recherchant le numéro saisi en
cellule J4. Il faut que le format de cette cellule soit personnalisé
(0000000) pour qu'un zéro initial soit pris en compte (la propriété Text
de la cellule permet de prendre en compte son contenu affiché).
Si le code n'est pas lancé depuis le classeur qui contient la cellule J4
et que la feuille qui contient cette même cellule n'est pas la feuille
active, il faudra qualifier entièrement le chemin d'accès à J4 (par
exemple :

AChercher =
Workbooks("leclasseur.xls").sheets("lafeuille").Range("J4").Text)

'=================== >>>> Sub OuvreDevis_2()
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$

AChercher = Range("J4").Text 'modif ici
NomDossier = "C:CONCEPT HabitatDevis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
Workbooks.Open NomDossier & File.Name
Exit For
End If
Next
End If

End Sub
'=================== >>>>
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Re

J'ai oublié de présiser que dans mon formulaire
je rentre le N° de devis à rechercher dans une cellule en J4
Merci encore et bonne soirée.
Peponne31

"FS" a écrit :

Bonsoir,

Une approche légèrement différente de celle de Denis :

'=================== >>>>>> Sub OuvreDevis()
Dim fso As Object, Dossier As Object, NomDossier$
Dim Files As Object, File As Object, AChercher$

AChercher = _
Format(InputBox("Saisir le numéro du devis à ouvrir"), "0000000")
NomDossier = "C:CONCEPT HabitatDevis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.getfolder(NomDossier)
Set Files = Dossier.Files
If Files.Count <> 0 Then
For Each File In Files
If InStr(1, File.Name, AChercher, vbTextCompare) <> 0 Then
Workbooks.Open NomDossier & File.Name
Exit For
End If
Next
End If

End Sub
'=================== >>>>>>
FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

Peponne31 a écrit :

Bonjour,

Je voudrais ouvrir un formulaire enregistré dans un répetoire.
Ce formulaire est un devis que je veux transformer en facture.
Mes devis sont enregistrés enregistré comme suit: "Mme & M. DURAND 0909012"
ou bien "M. DUCHEMIN 0909013" et je voudrais l'ouvrir en ne me servant que de
son N° pour le rappeler: "0909012".
J'ai commencé un bout de code mais ne sais pas le terminer, pas assé
compétant.

Private Sub OuvreDevis()
Dim Chemin As String
Dim Feuille As String
Chemin = "C:CONCEPT HabitatDevis"
Workbooks.Open Chemin & Fich & ".xls"
End Sub

Si qulqu'un peux m'aider ce serai avec grand plaisir.Peponne31