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

aubelix · 23 Décembre 2010

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.

repcheks · 24 Décembre 2010

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

aubelix · 24 Décembre 2010

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.

Paritec · 24 Décembre 2010

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

Bonjour aubelix,
alors toujours une indigestion de sanglier?
ton fichier n'est pas bon mauvais format de je ne sais plus quoi
alors
a+
papou 😱

aubelix · 24 Décembre 2010

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.

Paritec · 24 Décembre 2010

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 😱

repcheks · 24 Décembre 2010

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.

aubelix · 24 Décembre 2010

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.

repcheks · 24 Décembre 2010

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 !

aubelix · 24 Décembre 2010

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

Bonjoiur Repcheks. 🙂

Mille mercis pour ton aide.
Tout fonctionne bien.

Très bonnes fêtes à toi et tous les Amis du Forum.

Cordialement.

aubelix · 28 Décembre 2010

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.

aubelix · 29 Décembre 2010

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

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

aubelix · 29 Décembre 2010

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.

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

aubelix

XLDnaute Impliqué

Pièces jointes

repcheks

XLDnaute Junior

aubelix

XLDnaute Impliqué

Paritec

XLDnaute Barbatruc

aubelix

XLDnaute Impliqué

Paritec

XLDnaute Barbatruc

repcheks

XLDnaute Junior

aubelix

XLDnaute Impliqué

repcheks

XLDnaute Junior

aubelix

XLDnaute Impliqué

aubelix

XLDnaute Impliqué

aubelix

XLDnaute Impliqué

Pièces jointes

aubelix

XLDnaute Impliqué

Discussions similaires

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

XLDnaute Impliqué

Pièces jointes

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Junior

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency