Userform pour ouvrir un classeur

K

kioups

XLDnaute Occasionnel
Bonjour à tous !

J'aimerai créer un userform d'un classeur1 afin d'ouvrir un classeur2 et de transférer des données du classeur2 au classeur1.

Bon, la macro pour transférer les données fonctionne sans problèmes.

Ce que je veux avec mon userform, c'est que l'utilisateur aille chercher le classeur2 de son choix.

Alors, j'aimerai savoir comment créer un Userform genre "Enregistrer sous". Après, je dois pouvoir me débrouiller pour lancer ma macro automatiquement.
Puis, je dois pouvoir trouver le truc pour fermer le classeur2.

Je viens de tenter le coup en "enregistrant une macro" à partir de mon classeur, je suis aller ouvrir le classeur2, puis le refermer et ça m'a donné :

Code: 
Sub Ouvrir_Fermer_classeur()
'
' Ouvrir_Fermer_classeur Macro
'

'
    ActiveWorkbook.Close
End Sub

C'est pas trop ça... :rolleyes:

Merci d'avance !

Kioups
 
Trier par date Trier par votes
nolich

nolich

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Bonsoir kioups, bonsoir à toutes et à tous :)

Tu peux, peut-être, essayer ce genre de code :

Code: 
Option Explicit

Const ChDir = "C:\MesFichiersExcel"
Const NomFichier = "MonFichier.xls"

Sub OuvrirFichier()
    Workbooks.Open Filename:=ChDir & "\" & NomFichier
    ' ... Ton code
    Windows(ChDir & "\" & NomFichier).Close
End Sub

Tiens-nous au courant :)

@+
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Pour "simplifier" ma question, est-ce que c'est possible de créer un userform genre "Enregistrer sous" où j'ai la possibilité de choisir n'importe quel dossier sur mon PC puis n'importe quel fichier dans ce dossier ?
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Bon, j'ai trouvé un truc tout bête...

Me suffit "a priori" de commencer ma macro par :
Application.GetOpenFilename

Alors, j'ai fait une macro juste avec ça :

Code: 
Sub Ouvrir_Fermer_classeur()
Application.GetOpenFilename
End Sub

J'ai mis un raccourci clavier pour la lancer.
Je la lance dans mon classeur, je choisis le classeur à ouvrir et....
il ne s'ouvre pas...

Que faire ?

Kioups
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Bon, j'ai pas mal de trucs...

J'ai fait une macro qui, par un raccourci clavier, ouvre un classeur, applique la macro de transfert et ferme le classeur.

J'ai un souci de lien entre les deux macros.

Voici ma macro d'ouverture/fermeture :

Code: 
Sub Ouvrir_Fermer_classeur()

Dim Nom As String
       
    Nom = Application.GetOpenFilename()
        If Nom = "" Then
    MsgBox "Aucun Fichier Sélectionné", vbOKOnly + vbCritical, "Importation des votes non réalisée "
    Exit Sub
    
    Else
    Workbooks.Open Filename:=Nom
    Importation_Journée (Nom)
    Workbooks(Nom).Close
    
        End If

End Sub

Et ma macro de transfert (oui, je sais, elle est très moche...)

Code: 
Sub Importation_Journée(Nom As String)
'
Dim NumeroJournee As Integer
Dim JoueursJournee As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NomJoueur As String
Dim NbreJoueursTotal As Integer
Dim ColonneJoueur As Integer
'
' Sélection de la feuille
    Windows(Nom).Activate  [COLOR="Red"][B]Ca merde ici !!!!!![/B][/COLOR]
' Rajout des deux calculs
    Cells(4, 1).Select
    ActiveCell.FormulaR1C1 = _
        "=VALUE(IF(RIGHT(LEFT(R[-1]C,14))=""e"",RIGHT(LEFT(R[-1]C,13)),RIGHT(LEFT(R[-1]C,14),2)))"
    Cells(7, 1).Select
    ActiveCell.FormulaR1C1 = "=VALUE(LEFT(R[-1]C,2))"
    NumeroJournee = Cells(4, 1).Value
    JoueursJournee = Cells(7, 1).Value
    Cells(4, 1).Value = ""
    Cells(7, 1).Value = ""
' Suppression des bordures
    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
' Suppression du fusionnage
    Selection.UnMerge
' Sélection des matchs de la journée
    Range("B9:C18").Select
    Selection.Copy
' Copie dans le classeur
    Windows("Classeur L1 2008-2009").Activate
    Cells(6 + 18 * (NumeroJournee - 1), 2).Select
    ActiveSheet.Paste
' Sélection d'un joueur
    For i = 1 To JoueursJournee
        Windows("Nom").Activate
        NomJoueur = Cells(8, 8 + 4 * (i - 1))
    ' Savoir si le joueur existe déjà ou pas
        NbreJoueursTotal = Workbooks("Classeur L1 2008-2009").Worksheets("Feuil1").Range("B1").Value
        k = 1
        Do While k < NbreJoueursTotal + 1
            If Workbooks("Classeur L1 2008-2009").Worksheets("Feuil1").Cells(4, 15 + 3 * (k - 1)).Value = NomJoueur Then
                ColonneJoueur = 15 + 3 * (k - 1)
                Exit Do
            Else
                k = k + 1
            End If
        Loop
    ' Copie du nom du joueur
        If k = NbreJoueursTotal + 1 Then
            ColonneJoueur = 15 + 3 * NbreJoueursTotal
            Cells(8, 8 + 4 * (i - 1)).Select
            Application.CutCopyMode = False
            Selection.Copy
            Windows("Classeur L1 2008-2009").Activate
            Cells(4, ColonneJoueur).Select
            ActiveSheet.Paste
        ' Fusionnage des cellules
            Range(Cells(4, ColonneJoueur), Cells(4, ColonneJoueur + 2)).Select
            Application.CutCopyMode = False
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            Selection.Merge
        ' Copie des votes du joueur
            Windows("Nom").Activate
            Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Select
            Selection.Copy
            Windows("Classeur L1 2008-2009").Activate
            Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur).Select
            ActiveSheet.Paste
        Else
            Windows("Nom").Activate
            Range(Cells(9, 8 + 4 * (JoueursJournee - 1)), Cells(18, 9 + 4 * JoueursJournee - 1)).Select
            Selection.Copy
            Windows("Classeur L1 2008-2009").Activate
            Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur).Select
            ActiveSheet.Paste
        End If
    Next i
End Sub
 
Vote positif 0 Vote négatif
B

Bebere

XLDnaute Barbatruc
Re : Userform pour ouvrir un classeur

bonjour Kioups,Mekkaoui,Nolich
vois si cela te convient,à adapter

Sub testfilopen()
Dim F As String, CheminF As String, NomF As String

F = FileOpen

For I = Len(F) To 1 Step -1
If Mid(F, I, 1) = "\" Then Exit For
Next

NomF = Mid(F, I + 1) 'ou Right(F, Len(F) - I)
CheminF = Mid(F, 1, I) 'ou Left(F, Len(F) - Len(NomF))

Workbooks.Open Filename:=NomF

End Sub

Function FileOpen(Optional ByVal sTitle As String = "Choisir le(s) fichier(s)", _
Optional ByVal bAllowMultiSelect As Boolean = False, _
Optional ByVal sFiltreName As String = "Excel", _
Optional ByVal sFiltreContent As String = "*.xls") As String
' CHOIX D'UN FICHIER PAR VBA
'Optional ByVal sFiltreName As String = "Images"
' Optional ByVal sFiltreContent As String = "*.bmp; *.gif; *.jpg; *.jpeg; *.png"

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.Title = sTitle 'Titre
.AllowMultiSelect = bAllowMultiSelect 'Choix multiples
.Filters.Add sFiltreName, sFiltreContent, 1 'Filtre image
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
FileOpen = Trim(FileOpen & "|" & vrtSelectedItem)
Next vrtSelectedItem
Else
'Bouton Annuler
End If
End With
Set fd = Nothing
End Function

à bientôt
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Merci Bebere...

Je crois que j'ai trouvé plus simple pour ouvrir mon fichier...

Enfin, à vrai dire, je ne comprends pas grand chose à ce que tu as écrit. Comme tu peux le voir, je suis plutôt très amateur en VBA ! ;-)

Là, j'ai plutôt a priori un problème de "noms" entre mes deux macros...

Dans Windows().Activate, entre parenthèses, je dois avoir un nom de classeur sans extension.
Comme ici : Windows("Classeur L1 2008-2009").Activate

Mais quand je mets Windows(Nom).Activate
Nom est le nom avec extension (par exemple Journee1.xlsm ou .xlsx...)

Faudrait que je supprime l'extension et ça devrait rouler, non ????

Kioups
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Bonjour vbacrumble.

Je n'avais pas vu le forum Excel 2007.
Ceci dit, je ne pense pas que mon problème soit lié directement aux extensions .xlsm ou .xlsx...

Et vu l'affluence sur le forum 2007....

A+

Kioups
 
Vote positif 0 Vote négatif
nolich

nolich

XLDnaute Occasionnel
Re : Userform pour ouvrir un classeur

Re kioups, bonjour mekkaoui1963 et Bebere, bonjour à toutes et à tous :)

kioups à dit:
Même échec en mettant
Workbooks(Nom).Activate

Peut-être parce que Nom est un string et devrait être autre chose, non ??
Cliquez pour agrandir...

Nom doit être de la forme "NomDuFichier.xls". Pour t'en persuader, ouvre 2 fichiers et va dans un module VBA (n'importe lequel des 2 fichiers) et écris ceci :

Code: 
Sub test()
'
Dim Nom1 As String, Nom2 As String
Dim TestNom1 As String, TestNom2 As String
'
  Nom1 = Windows(1).Caption
  Nom2 = Windows(1).Caption
  Windows(Nom1).Activate
  TestNom1 = ActiveWindow.Caption
  Windows(Nom2).Activate
  TestNom2 = ActiveWindow.Caption
End Sub

Puis sous VBA, tu exécutes cette macro en pas à pas (F8 quand le curseur est dans la macro) sans oublier d'afficher la fenêtre des variables locales (dans le menu Affichage).

Tu peux voir ce que ça donne au niveau des noms (propriété Caption).

@+

EDIT : C'est la même chose pour un objet Workbook, mise à part que la propriété utilisée est Name et non Caption...
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Activeworkbooks à partir d'une cellule
Réponses
1
Affichages
155
sousou
sousou
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
92
farid
F
C
  • Question
XL 2019 Coller valeur dans autre classeur
Réponses
14
Affichages
372
carlos
C
T
  • Question
Microsoft 365 Import de données et liaisons entre classeurs
Réponses
14
Affichages
542
TCHIS
T
P
  • Résolu(e)
XL 2010 Enregistrer sous un seul PDF toutes les feuilles visibles d'un classeur
Réponses
3
Affichages
210
Panda79360
P
M
  • Question
XL 2016 Excel UserForm VBA
Réponses
3
Affichages
250
patricktoulon
patricktoulon
medlight
  • Question
Autres Transfert des données d'un classeur à un autre
Réponses
5
Affichages
268
Oneida
Oneida
J
  • Résolu(e)
XL 2016 Validation d'une ligne et transfert de la ligne vers un autre classeur
Réponses
8
Affichages
211
job75
job75
S
  • Question
XL 2019 aide pour inclusion d'une nouvelle VBA
Réponses
0
Affichages
155
SamLion91
S
M
  • Question
Autres Générer une étiquette pour imprimante thermique
Réponses
3
Affichages
200
fanch55
fanch55

Membres actuellement en ligne

6 membres et 41 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 165
Messages
2 085 882
Membres
103 009
dernier inscrit
dede972