Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
aubelix

aubelix

XLDnaute Impliqué
Bonsoir à tous les Amis du Forum. 🙂

Je reviens vers vous pour vous demander de l'aide une fois de plus.
Mon problème est le suivant:
Dans la Feuille "BASE" en cellule "C2" il y'a une valeur qui correspond à un Type.
C'est renseigné via un USF tout fonctionne.
J'ouvre un modèle en fonction du type pour créer mes références.
Ce modele.xls je le place manuellement dans le répertore en fonction du type.
Car je ne sais pas comment faire pour que soit ouvert le modèle qui correspond au TYPE
par rapport au tableau dans la feuille "REFERENCES"

Merci pour votre aide.
Cordialement.
 

Pièces jointes

Trier par date Trier par votes
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Hello

En admettant que tes classeurs modeles soient placés dans "C:\Modeles" et nommés selon les données de la colonne C de la feuille reference, type "MODELE-5B.xls" :

Code: 
Dim rRefs as Range, rRef as Range
Dim sRef$, sMod$

Const MyPath="C:\Modeles\"

Sheets("REFERENCES").Activate
Set rRefs=Range("B2", Cells(Cells(65536,"B").end(xlUp).Row,"B"))

Sheets("BASE").Activate
sRef=Range("C2").Value

For Each rRef in rRefs

If rRef.Value = sRef Then

sMod=rRef.Offset(0,1).Value
Exit For

End If

Next rRef

Workbooks.Open(MyPath & sMod & ".xls")
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Bonjour Repcheks. 🙂

Merci pour ta réponse.

J'ai essayé de l'adapter, mais il y'a une erreur.
Apparamment il ne trouve pas le modèle. Il m'affiche:
Erreur d'exécution 1004

C:\modeles\.xls introuvable.

Code: 
C:\modeles\.xls

Ci-dessous mon code complet.

Code: 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub CREATION_REFS()
    Dim Sh As Worksheet
    Dim Cel As Range, plg As Range
    Dim VarC12 As Variant
    Select Case MsgBox(" Voulez-vous lancer la création des REFS ? " _
                     & vbCrLf & "        (Un onglet par Numéro de Série) " _
         , vbYesNo Or vbQuestion Or vbDefaultButton1, "Confirmer votre choix...")
 
    Case vbYes
 
        UserFormAttente.Show 0
        UserFormAttente.Repaint
        Sheets("BASE").Activate
        Range("B2").Select
 
        Set plg = Range(Selection, Selection.End(xlDown))
 
        For Each Cel In plg.Cells
            If Cel <> "" Then
                For Each Sh In Worksheets
                    If Sh.Name = Cel Then GoTo suite
                Next
                UserFormAttente.Label2.Caption = vbCrLf & "Création de la REF pour le SN : " & vbCrLf & Cel.Value & vbCrLf
                UserFormAttente.Label2.ForeColor = &H400000
                UserFormAttente.Repaint
 
                'Tempo de x millisecondes
                Sleep 5
 
                Application.ScreenUpdating = False
 
 
Dim rRefs As Range, rRef As Range
Dim sRef$, sMod$
Const MyPath = "C:\Modeles\"
 
Sheets("REFERENCES").Activate
Set rRefs = Sheets("REFERENCES").Range("B2", Cells(Cells(65536, "B").End(xlUp).Row, "B"))
Sheets("BASE").Activate
sRef = Range("E2").Value
For Each rRef In rRefs
If rRef.Value = sRef Then
sMod = rRef.Offset(0, 1).Value
Exit For
End If
Next rRef
Workbooks.Open (MyPath & sMod & ".xls")
 
 
                Sheets.Add Type:=MyPath & sMod & ".xls", _
                           After:=Sheets(Sheets.Count)
 
 
 
                Sheets(Sheets.Count).Name = Cel.Value
                'Recopie les différentes rubriques spécifiées
                With Sheets("BASE")
                    VarD13 = .Range("E2").Value
                    VarA13 = .Range("A2").Value
                    VarF34 = .Range("J2").Value
                    VarG13 = .Range("D2").Value
                    VarI13 = .Range("B2").Value
                    VarK4 = .Range("C2").Value
                    VarK8 = .Range("G2").Value
                    VarK13 = .Range("H2").Value
                End With
                With Sheets(Sheets.Count)
 
                    'PN
                    If Sheets("BASE").Range("E" & Cel.Row).Value <> "" Then VarD13 = Sheets("BASE").Range("E" & Cel.Row).Value
                    .Range("D13").Value = VarD13
                    'N°
                    If Sheets("BASE").Range("A" & Cel.Row).Value <> "" Then VarA13 = Sheets("BASE").Range("A" & Cel.Row).Value
                    .Range("A13").Value = VarA13
                    'Responsable
                    If Sheets("BASE").Range("J" & Cel.Row).Value <> "" Then VarF34 = Sheets("BASE").Range("J" & Cel.Row).Value
                    .Range("F34").Value = VarF34
                    'Quantité
                    If Sheets("BASE").Range("D" & Cel.Row).Value <> "" Then VarG13 = Sheets("BASE").Range("D" & Cel.Row).Value
                    .Range("G13").Value = VarG13
                    'Référence
                    If Sheets("BASE").Range("B" & Cel.Row).Value <> "" Then VarI13 = Sheets("BASE").Range("B" & Cel.Row).Value
                    .Range("I13").Value = VarI13
                    'N° de suivi
                    If Sheets("BASE").Range("C" & Cel.Row).Value <> "" Then VarK4 = Sheets("BASE").Range("C" & Cel.Row).Value
                    .Range("K4").Value = VarK4
                    'Ordre
                    If Sheets("BASE").Range("G" & Cel.Row).Value <> "" Then VarK8 = Sheets("BASE").Range("G" & Cel.Row).Value
                    .Range("K8").Value = VarK8
                    'Status
                    If Sheets("BASE").Range("H" & Cel.Row).Value <> "" Then VarK13 = Sheets("BASE").Range("H" & Cel.Row).Value
                    .Range("K13").Value = VarK13
                End With
            End If
suite:
        Next Cel
        Unload UserFormAttente
        Uf_Ok.Show 0
        Uf_Ok.Repaint
    Case vbNo
        Exit Sub
    End Select
    Sheets("BASE").Activate
    Range("A1").Select
End Sub

Nota:

D'autre part, ma feuille "REFERENCES" est masquée pour éviter que les utilisateurs
modifient des données.

Merci pour ton aide.
Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Bonjour Paritec. 🙂

Merci pour ta réponse.

Pourtant je n'ai pas encore festoyé...
Ci-joint lien du fichier.



Merci pour ton aide.
Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

re bonjour Aubelix,
alors maintenant ton fichier est bien passé BRAVO
mais il n'y a rien dedans aucunes explications aucunes macro enfin bref un fichier que l'on ferme et on passe à autre chose.
Certaine fois en voyant cela je me demande pourquoi je persiste à vouloir aider, les répondeurs sont plus impliqués, que les demandeurs c'est grave tout de même!!
a+
papou 😱
 
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Bon, normal que ca ne fonctionne pas, j'allais chercher la reference en cellule C2 comme indiqué dans le premier message, alors qu'elle est en F2 dans le classeur joint.

Puis je ne savais pas que la feuilles"REFERENCES" devait etre cachée. Si c'est le cas, la méthode Activate ne peut etre appliquée telle quelle.

voici donc une adaptation du bout de code.

Code: 
Dim rRefs As Range, rRef As Range
Dim sRef$, sMod$
Const MyPath = "C:\Modeles\"

Application.ScreenUpdating = False

Sheets("REFERENCES").Visible = True

Sheets("REFERENCES").Activate
Set rRefs = Sheets("REFERENCES").Range("B2", Cells(Cells(65536, "B").End(xlUp).Row, "B"))

Sheets("REFERENCES").Visible = False

Sheets("BASE").Activate
sRef = Range("F2").Value

Application.ScreenUpdating = True

For Each rRef In rRefs

    If rRef.Value = sRef Then
    
        sMod = rRef.Offset(0, 1).Value
        Exit For
        
    End If
    
Next rRef
 
Sheets.Add Type:=MyPath & sMod & ".xls", After:=Sheets(Sheets.Count)

Par contre j'ai supposé que tes modeles etaient dans "C:\Modeles", mais il faut que tu adaptes cela avec le repertoire qui correspond chez toi en changeant la constante suivante:

Code: 
Const MyPath = "C:\Modeles\"

N'oublie pas de bien mettre un "\" a la fin, ou cela ne fonctionnera pas.
 
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Bonjoiur Paritec et Repcheks. 🙂

Merci pour vos réponses respectives.
Paritec, je suis désolé, j'aurai dû ajouter le code dans le
fichier avec le lien. je suis parti du principe que je l'avais
adressé à Repcheks, il était inutile que je le recopie.
Grave erreur de ma part et une fois de plus je te prie
d'accepter mes excuses au regard du temps que vous
consacrez à nous aider, je m'en veux !...

Ci-joint le lien du Fichier.

Cijoint.fr - Service gratuit de dépôt de fichiers

D'autre part, Repcheks j'ai testé ton code, il fonctionne.
Est-il possible d'avoir un message d'erreur (Message Box) si le fichier
n'est pas trouvé.

Par avance, Merci pour votre aide.
Cordialement.
 
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Code: 
Dim rRefs As Range, rRef As Range
Dim sRef$, sMod$
Const MyPath = "C:\Modeles\"

Application.ScreenUpdating = False

Sheets("REFERENCES").Visible = True

Sheets("REFERENCES").Activate
Set rRefs = Sheets("REFERENCES").Range("B2", Cells(Cells(65536, "B").End(xlUp).Row, "B"))

Sheets("REFERENCES").Visible = False

Sheets("BASE").Activate
sRef = Range("F2").Value

Application.ScreenUpdating = True

For Each rRef In rRefs

    If rRef.Value = sRef Then
    
        sMod = rRef.Offset(0, 1).Value
        Exit For
        
    End If
    
Next rRef

If Dir(MyPath & sMod & ".xls")="" Then
Msgbox("Modele non trouvé",vbOkOnly)
Exit Sub
End If
 
Sheets.Add Type:=MyPath & sMod & ".xls", After:=Sheets(Sheets.Count)

Voila !
 
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Bonsoir à tous les Amis du Forum. 🙂

Je reviens vers pour une variante du code qui fonctionne très bien.
Grâce à l'aide de Repcheks.

J'aurai souhaité ouvrir le modèle qui se trouve dans le sous-répertoire
en cellule "J2" dela feuille "BASE".

Cijoint.fr - Service gratuit de dépôt de fichiers

Chaque responsable a un sous-répertoire à son nom.

J'ai essayé, mais j'ai des message d'erreur.

Par avance, Merci pour votre aide.
Cordialement.
 
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Affectation de variable pour ouvrir un fichier

Bonjour à tous les Amis du Forum 🙂

J'ai essayé d'affecter des variables à ce code, mais j'ai des problèmes:
J'arrive à ouvrir le Modele.xls qui se trouve dans le sous-répertoire de la
valeur de la cellule "J2".
Ensuite, Excel se ferme, erreur, sans explication...



MESSAGE_D_ERREUR.gif


Cijoint.fr - Service gratuit de dépôt de fichiers

Mon problème se situe sur les affectation de variables


Code :
Dim rRef As Range

'ouvrir la feuille "modele.xls" dans le S/répertoire correspondant
'à valeur de la cellule "J2" de la feuille "BASE"
'chaque responsable a un sous-répertoire à son nom.
Const MyPath = "C:\REP1\REP2\REP3\REP4\REP5\Modeles\"
Sheets("BASE").Activate
sMod = Range("J2").Value
sRef = "Modele.xls"
Application.DisplayAlerts = False

Workbooks.Open (MyPath & sMod & "\" & sRef)

Sheets.Add Type:=MyPath & sMod & "\" & sRef, _
After:=Sheets(Sheets.Count)




Le but de la macro, est d'ouvrir un modele en fonction de la valeur
de la cellule "J2" de la feuille "BASE". et de dupliquer en copiant les
données de la feuille (cela fonctionne).

Merci pour votre aide.
Cordialement
​
 

Pièces jointes

  • MESSAGE_D_ERREUR.gif
    MESSAGE_D_ERREUR.gif
    6.3 KB · Affichages: 96
  • MESSAGE_D_ERREUR.gif
    MESSAGE_D_ERREUR.gif
    6.3 KB · Affichages: 115
  • MESSAGE_D_ERREUR.gif
    MESSAGE_D_ERREUR.gif
    6.3 KB · Affichages: 119
  • MESSAGE_D_ERREUR.gif
    MESSAGE_D_ERREUR.gif
    18.1 KB · Affichages: 158
  • MESSAGE_D_ERREUR.gif
    MESSAGE_D_ERREUR.gif
    18.1 KB · Affichages: 160
Dernière édition:
Vote positif 0 Vote négatif
Re : Ouverture d'un fichier modèle en fonction de la valeur d'une cellule

Re Bonjour à tous les Amis du Forum. 🙂

Je me permets de vous relancer suite au problème rencontré
lors de l'exécution de la Macro. (voir image jointe)
J'ai essayé sur d'autres postes, et Excel se ferme !

Quelqu'un aurait-il une idée de l'origine de cette anomalie ?
Le fichier Modele s'ouvre et j'ai le message d'erreur et Excel se ferme 😡.

Par avance, Merci pour votre aide.
Cordialemenrt.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
XL 2010 Surligner texte en fonction d'une valeur en cellule K
Réponses
7
Affichages
221
ascal44
A
F
  • Question Question
Autres Récupération de données d'une feuille X en fonction de la valeur de cellule dans une collone d'une feuille Y
2
Réponses
27
Affichages
928
fanfan38
fanfan38
D
  • Résolu(e)
Microsoft 365 Récupérer la valeur d'une cellule d'un autre fichier
Réponses
7
Affichages
322
Diane272727
D
M
  • Question Question
Microsoft 365 Fonction Index ( sélectionner la Matrice en fonction de cellule
Réponses
3
Affichages
117
manuZ51
M
J
  • Question Question
XL 2010 définir un nom de cellule en fonction de la valeur d'une autre
Réponses
12
Affichages
992
jojo4738
J
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
349
JHA
J
R
  • Question Question
XL pour MAC Action d'une formule conditionnelle dans une cellule en fonction de la couleur de cette cellule
2
Réponses
17
Affichages
428
rtlv17
R
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
231
piga25
piga25
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
314
Phil69970
Phil69970
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la création de feuilles en fonction des données de la cellule U13 et une feuille type
Réponses
7
Affichages
601
chaelie2015
chaelie2015
M
  • Question Question
Microsoft 365 Comptabilité : Création d'un fichier automatique d'analyse de comptes
Réponses
2
Affichages
682
Max
M
I
  • Résolu(e)
Microsoft 365 Exécuter une macro en fonction de la valeur d'une cellule
Réponses
12
Affichages
716
iliess
I
C
  • Question Question
Microsoft 365 Change d'image en fonction du changement de valeur d'une cellule (résolu)
Réponses
5
Affichages
445
Cougar
C
P
  • Résolu(e)
XL pour MAC Problème de changement de couleur de la valeur d'une cellule
Réponses
2
Affichages
447
pvander
P
nrdz83
  • Question Question
XL 2016 [Resolu]Fond de couleur de la cellule en fonction du texte choisi
Réponses
12
Affichages
191
job75
job75
Z
  • Question Question
XL 2021 InputBox and focus à la fin de la ligne d'une valeur par défaut
Réponses
4
Affichages
432
zedude
Z
N
  • Question Question
XL 2013 Fixer la valeur d'une cellule saisie en fonction d'un nombre de décimal défini
Réponses
6
Affichages
365
mapomme
mapomme
oguruma
EXCEL :: TCD :: SEGMENTS :: Identifier l'élément sélectionné dans le segment :: Modifier dynamiquement la valeur d'un segment :: VBA
Réponses
1
Affichages
266
oguruma
oguruma
Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
204
Lu76Fer
Lu76Fer
B
  • Question Question
XL 2016 Ramener une plage de données en fonction d'une cellule
Réponses
11
Affichages
521
JHA
J
Retour