Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Ouvrir un formulaire situé dans un répertoire

15 réponses
Avatar
Peponne31
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 Habitat\Devis\"
Workbooks.Open Chemin & Fich & ".xls"
End Sub

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

10 réponses

1 2
Avatar
michdenis
Bonjour Peponne31,

Essaie ceci :

'-----------------------------------------------
Sub test()

Dim Repertoire As String
Dim Fichier As String
Dim Ok As Boolean
Dim Numero As String

Repertoire = "C:CONCEPT HabitatDevis"
Numero = "0909012" ' à déterminer

Fichier = Dir(Repertoire & "*.xls")
Do While Fichier <> ""
If InStr(1, Fichier, Numero, vbTextCompare) <> 0 Then
Workbooks.Open répertoire & Fichier
Ok = True
Exit Do
End If
Loop
If Ok = False Then
MsgBox "fichier introuvable"
End If
End Sub
'-----------------------------------------------




"Peponne31" a écrit dans le message de groupe de
discussion :
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
Avatar
Peponne31
Bonsoir Michdenis

Merci pour ton aide, j'ai appliqué ta solution et j'ai planté excel.
Je nai pas assé de compétance pour adapter ton code,
j'ai ce code qui fonctionne bien mais uniquement pour les devis
enregistrés avec un N° , pas avec un Nom et un N°

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$J$6" Then
ValideSaisie
ActiveSheet.Unprotect
LectureDeJ6
EcritureDeB10
ActiveSheet.Protect

Feuille = ActiveSheet.Name
ElseIf Target.Address = "$J$3" Then
RéouvreDevis1page Target.Value ' ici appel pour réouvrir le devis
ActiveSheet.Unprotect
MaValeurDeB10
MaValeurDeJ6
ActiveSheet.Protect
End If
End Sub

Sub RéouvreDevis1page(Fich)
ActiveSheet.Unprotect
Range("I12").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Value = ActiveCell.Value
Range("date").Select
ActiveCell.Value = ActiveCell.Value
Dim Chemin As String, Ctr As Integer, Plage As Range, c As Range
Dim Message As String
Chemin = "C:CONCEPT Habitatdevis"
Ctr = 21
Err = 0
On Error Resume Next
Workbooks.Open Chemin & Fich & ".xls"
If Err = 1004 Then
zz_Clignote2
Message = MsgBox("Ce N° de devis n'existe pas !", vbInformation,
"CONCEPT Habitat")
Selection.ClearContents
Range("J3,I12").Select
Selection.ClearContents
Range("J3").Activate
Sheets("Devis1Page").Protect

End If

Feuille = ActiveSheet.Name
With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
.Range("num_client") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client")
.Range("dnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
.Range("numdevis1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("numdevis1")
.Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
.Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
.Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
.Range("fcp") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("fcp")
.Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
.Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
.Range("fremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
.Range("B17") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("B17")
.Range("H4") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H4")
.Range("H5") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H5")
.Range("I51") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("I51")
Set Plage = Workbooks(Fich & ".xls").Sheets(Feuille).Range("A21:A50")
For Each c In Plage

.Range("A" & Ctr) = c.Value
.Range("F" & Ctr) = c.Offset(0, 1)
.Range("G" & Ctr) = c.Offset(0, 2)
.Range("H" & Ctr) = c.Offset(0, 3)
.Range("J" & Ctr) = c.Offset(0, 5)
Ctr = Ctr + 1
Next c
NuméroDevis '***** Met à jour le fichier du N° de devis
Workbooks(Fich & ".xls").Close False
ActiveSheet.Protect
End With
End Sub

Je ne sais si tu peux adapter
Merci quand mème si veux bien essayer



"michdenis" a écrit :

Bonjour Peponne31,

Essaie ceci :

'-----------------------------------------------
Sub test()

Dim Repertoire As String
Dim Fichier As String
Dim Ok As Boolean
Dim Numero As String

Repertoire = "C:CONCEPT HabitatDevis"
Numero = "0909012" ' à déterminer

Fichier = Dir(Repertoire & "*.xls")
Do While Fichier <> ""
If InStr(1, Fichier, Numero, vbTextCompare) <> 0 Then
Workbooks.Open répertoire & Fichier
Ok = True
Exit Do
End If
Loop
If Ok = False Then
MsgBox "fichier introuvable"
End If
End Sub
'-----------------------------------------------




"Peponne31" a écrit dans le message de groupe de
discussion :
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



Avatar
michdenis
Ok, essaie cette version :

J'avais écrit "Répertoire" mais la variable est "Repertoire"
et j'avais oublier d'insérer la ligne Fichier = dir

Pour déterminer la valeur de la variable numero, cette
dernière peut être renseigné en utilisant une cellule !

Numero = Sheets("NomDelaFeuille").Range("A1").value

L'extension utilisée est ".xls" dans cette ligne de code...
Fichier = Dir(Repertoire & "*.xls")
Mais tu peux utiliser l'extension de la version Excel 2007 si besoin.
"*.xlsm" ou "*.xlsx" ou même "*.xls*"


'------------------------------------------
Sub test()
Dim Repertoire As String
Dim Fichier As String
Dim Ok As Boolean
Dim Numero As String

Repertoire = "C:CONCEPT HabitatDevis"
Numero = "125" ' à déterminer

Fichier = Dir(Repertoire & "*.xls")
Do While Fichier <> ""
If InStr(1, Fichier, Numero, vbTextCompare) <> 0 Then
Workbooks.Open Repertoire & Fichier
Ok = True
Exit Do
End If
Fichier = Dir
Loop
If Ok = False Then
MsgBox "fichier introuvable"
End If

End Sub
'------------------------------------------




"Peponne31" a écrit dans le message de groupe de
discussion :
Bonsoir Michdenis

Merci pour ton aide, j'ai appliqué ta solution et j'ai planté excel.
Je nai pas assé de compétance pour adapter ton code,
j'ai ce code qui fonctionne bien mais uniquement pour les devis
enregistrés avec un N° , pas avec un Nom et un N°

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$J$6" Then
ValideSaisie
ActiveSheet.Unprotect
LectureDeJ6
EcritureDeB10
ActiveSheet.Protect

Feuille = ActiveSheet.Name
ElseIf Target.Address = "$J$3" Then
RéouvreDevis1page Target.Value ' ici appel pour réouvrir le devis
ActiveSheet.Unprotect
MaValeurDeB10
MaValeurDeJ6
ActiveSheet.Protect
End If
End Sub

Sub RéouvreDevis1page(Fich)
ActiveSheet.Unprotect
Range("I12").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Value = ActiveCell.Value
Range("date").Select
ActiveCell.Value = ActiveCell.Value
Dim Chemin As String, Ctr As Integer, Plage As Range, c As Range
Dim Message As String
Chemin = "C:CONCEPT Habitatdevis"
Ctr = 21
Err = 0
On Error Resume Next
Workbooks.Open Chemin & Fich & ".xls"
If Err = 1004 Then
zz_Clignote2
Message = MsgBox("Ce N° de devis n'existe pas !", vbInformation,
"CONCEPT Habitat")
Selection.ClearContents
Range("J3,I12").Select
Selection.ClearContents
Range("J3").Activate
Sheets("Devis1Page").Protect

End If

Feuille = ActiveSheet.Name
With Workbooks("CONCEPT Habitat.xls").Sheets("Devis1page")
.Range("num_client") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("num_client")
.Range("dnomcli1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dnomcli1")
.Range("numdevis1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("numdevis1")
.Range("frue1") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue1")
.Range("frue2") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("frue2")
.Range("fville") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("fville")
.Range("fcp") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("fcp")
.Range("téléphone") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("téléphone")
.Range("portable") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("portable")
.Range("fremise") = Workbooks(Fich &
".xls").Sheets(Feuille).Range("dremise")
.Range("B17") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("B17")
.Range("H4") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H4")
.Range("H5") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("H5")
.Range("I51") = Workbooks(Fich & ".xls").Sheets(Feuille).Range("I51")
Set Plage = Workbooks(Fich & ".xls").Sheets(Feuille).Range("A21:A50")
For Each c In Plage

.Range("A" & Ctr) = c.Value
.Range("F" & Ctr) = c.Offset(0, 1)
.Range("G" & Ctr) = c.Offset(0, 2)
.Range("H" & Ctr) = c.Offset(0, 3)
.Range("J" & Ctr) = c.Offset(0, 5)
Ctr = Ctr + 1
Next c
NuméroDevis '***** Met à jour le fichier du N° de devis
Workbooks(Fich & ".xls").Close False
ActiveSheet.Protect
End With
End Sub

Je ne sais si tu peux adapter
Merci quand mème si veux bien essayer



"michdenis" a écrit :

Bonjour Peponne31,

Essaie ceci :

'-----------------------------------------------
Sub test()

Dim Repertoire As String
Dim Fichier As String
Dim Ok As Boolean
Dim Numero As String

Repertoire = "C:CONCEPT HabitatDevis"
Numero = "0909012" ' à déterminer

Fichier = Dir(Repertoire & "*.xls")
Do While Fichier <> ""
If InStr(1, Fichier, Numero, vbTextCompare) <> 0 Then
Workbooks.Open répertoire & Fichier
Ok = True
Exit Do
End If
Loop
If Ok = False Then
MsgBox "fichier introuvable"
End If
End Sub
'-----------------------------------------------




"Peponne31" a écrit dans le message de groupe de
discussion :
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



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


Avatar
Peponne31
Bonsoir FS,

Ton code fonctionne bien,
J'ai tout de mème un petit souci, du fait que je rajoute un nom devant le N°
il moublie le 1er zéro mais au passage en 2010 il met bien le 1
en fait, j'ai "M. DURANT 909012" pour 2009 et "M. DURAND 1001001" pour 2010
est-il possible de faire une recnerche sur 7 chiffres mème s'il ni en a que
6 ?

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



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



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


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





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






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



1 2