Ouvrir un fichier Excel en un double-clic

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,
J'ai comme projet de réaliser un fichier me permettant d'ouvrir un fichier Excel en double-clickant sur une cellule et d'en extraire les informations que je souhaite.
J'ai trouvé de la documentation sur le forum, mais rien qui ne corresponde à mes besoins.

J'ai réalisé le code suivant:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, cancel As Boolean) If ActiveCell.Address <> "$A$6" Then Exit Sub cancel = True With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show ActiveCell = .SelectedItems(1) End With End Sub
Les résultats sont mitigés, puisque lorsque je double-click sur la fameuse cellule A6, le fichier s'ouvre normalement comme sur la capture d'écran qui suit:

Pièce jointe 478235

Cependant, je n'ai un aperçu d'aucun fichier dans ce dossier qui en comporte pourtant plusieurs... Et j'avoue que je ne sais pas trop comment faire pour les rendre "visibles"... Mes fichiers sont normalement soit en format .xlsx soit au format .xlsm.

Merci à ceux qui auront la gentillesse de m'aiguiller un peu dans mon projet !

Bonne semaine à tous ! :D

Re-bonjour à tous,
J'ai trouvé une solution à mon problème:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, cancel As Boolean) Dim wbMyWb As Workbook Dim Nom_Fichier As Variant If ActiveCell.Address <> "$A$6" Then Exit Sub Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsm,") If Nom_Fichier <> False Then Set wbMyWb = Workbooks.Open(Nom_Fichier) wbMyWb.Activate End If End Sub
ça fonctionne parfaitement. Par contre, un nouveau problème se pose à moi… Outrément plus simple à mon avis. En fait, je ne sais pas comment nommer (en terme de VBA j'entends) le fichier que je sélectionne grâce à ma macro…

Par exemple, je veux récupérer le contenu de ma cellule A5 du fichier que j'ai ouvert, le copier dans mon fichier principal, et fermer le fichier ouvert.

J'ai essayé le code:

Code:

Cells(20, 3) = SelectedItems.Cells(1, 5)

En bref, je n'arrive pas à nommer mon nouveau fichier… J'ai testé selecteditems mais ça n'a pas l'air de fonctionner.

Quelqu'un pour m'aider ? :zoubi:

Merci beaucoup !

27/05/2019, 09h49
halaster08
Citation:

je ne sais pas comment nommer (en terme de VBA j'entends) le fichier que je sélectionne

Et pourtant tu l'as fait:

Code:

Set wbMyWb = Workbooks.Open(Nom_Fichier)

Citation:

je veux récupérer le contenu de ma cellule A5 du fichier que j'ai ouvert, le copier dans mon fichier principal, et fermer le fichier ouvert.

Il faudrait que tu précise en plus du classeur la feuille et la cellule sur laquelle tu souhaites coller. Mais ça ressemble à ça:
Code:

1 2 thisworkbook.sheets("nom de la feuille").range("adresse de la cellule").value = wbMyWb.activesheet.range("A5").value wbMyWb.close

Citation:
Envoyé par Mickamax
Bonjour à tous,
J'ai comme projet de réaliser un fichier me permettant d'ouvrir un fichier Excel en double-clickant sur une cellule et d'en extraire les informations que je souhaite.
J'ai trouvé de la documentation sur le forum, mais rien qui ne corresponde à mes besoins.

J'ai réalisé le code suivant:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, cancel As Boolean) If ActiveCell.Address <> "$A$6" Then Exit Sub cancel = True With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Show ActiveCell = .SelectedItems(1) End With End Sub
Les résultats sont mitigés, puisque lorsque je double-click sur la fameuse cellule A6, le fichier s'ouvre normalement comme sur la capture d'écran qui suit:

Pièce jointe 478235

Cependant, je n'ai un aperçu d'aucun fichier dans ce dossier qui en comporte pourtant plusieurs... Et j'avoue que je ne sais pas trop comment faire pour les rendre "visibles"... Mes fichiers sont normalement soit en format .xlsx soit au format .xlsm.

Merci à ceux qui auront la gentillesse de m'aiguiller un peu dans mon projet !

Bonne semaine à tous ! :D
Bonjour,

C'est normal :mrgreen:

extrait de l'aide en ligne :

Citation:

MsoFileDialogType peut être l'une de ces constantes MsoFileDialogType.

msoFileDialogFilePicker. Permet à l'utilisateur de sélectionner un fichier.
msoFileDialogFolderPicker. Permet à l'utilisateur de sélectionner un dossier.
msoFileDialogOpen. Permet à l'utilisateur d'ouvrir un fichier.
msoFileDialogSaveAs. Permet à l'utilisateur d'enregistrer un fichier.

Celui que tu as sélectionner (que j'ai mis en rouge ) ne montre aucun fichier présent juste que le dossier (Folder)

utilise plutôt :
- msoFileDialogFilePicker
ou
- msoFileDialogOpen

A+

1 pièce(s) jointe(s)

Salut,
Merci à vous deux pour votre aide !
Effectivement Igloobel, MsoFoldPicker n'allait pas, je me suis plutôt tourné vers GetOpenFileName et ça fonctionne très bien.

J'arrive au bout de mon projet, mais je rencontre un dernier problème :?:?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, cancel As Boolean) Dim wbMyWb As Workbook Dim Nom_Fichier As Variant Application.ScreenUpdating = False If ActiveCell.Address <> "$B$2" Then Exit Sub Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsm,") If Nom_Fichier <> False Then Set wbMyWb = Workbooks.Open(Nom_Fichier) wbMyWb.Activate End If Dligne = Range("B50000").End(xlUp).Row Workbooks.Open (Nom_Fichier) Sheets("Feuil1").Cells(4, 2).Copy Cells(Dligne + 1, 1).PasteSpecial Sheets("Feuil1").Cells(5, 2).Copy Cells(Dligne + 1, 5).PasteSpecial Sheets("Feuil1").Cells(6, 2).Copy Cells(Dligne + 1, 4).PasteSpecial Sheets("Feuil1").Cells(8, 2).Copy Cells(Dligne + 1, 2).PasteSpecial Sheets("Feuil1").Cells(9, 2).Copy Cells(Dligne + 1, 8).PasteSpecial Sheets("Feuil1").Cells(10, 2).Copy Cells(Dligne + 1, 6).PasteSpecial Sheets("Feuil1").Cells(11, 2).Copy Cells(Dligne + 1, 7).PasteSpecial Sheets("Feuil1").Cells(12, 2).Copy Cells(Dligne + 1, 3).PasteSpecial Workbooks(Nom_Fichier).Close Application.ScreenUpdating = True End Sub
Je n'arrive pas à fermer mon deuxième fichier une fois tous les copier-coller effectués…
J'ai testé Nom_Fichier.close mais ça n'a pas l'air de fonctionner…

Edit: Méa culpa, je viens de trouver un autre problème… Lorsque je lance ma macro, que je me retrouve dans mon dossier, si je quitte mon dossier en cliquant sur "annuler" ou par la croix en haut à droite, le message d'erreur suivant apparaît:

Pièce jointe 478276

Mickamax

27/05/2019, 11h09
halaster08
Code:

1 2 Sheets("Feuil1").Cells(8, 2).Copy Cells(Dligne + 1, 2).PasteSpecial
Vu que tu ne précise pas dans quel classeur tu colles tu copie tout sur la feuille active, ce qui est en contradiction avec:

Citation:

Par exemple, je veux récupérer le contenu de ma cellule A5 du fichier que j'ai ouvert, le copier dans mon fichier principal

Citation:

Je n'arrive pas à fermer mon deuxième fichier une fois tous les copier-coller effectués…
J'ai testé Nom_Fichier.close mais ça n'a pas l'air de fonctionner…

J'ai déjà répondu à cette question

Citation:

je viens de trouver un autre problème… Lorsque je lance ma macro, que je me retrouve dans mon dossier, si je quitte mon dossier en cliquant sur "annuler" ou par la croix en haut à droite, le message d'erreur suivant apparaît:

GetOpenFilename attend une valeur, si tu annule ou quitte il renvoi une erreur.
Il existe un tuto sur la gestion d'erreur (je l'ai pas sous la main mais une recherche Google devrais te le retrouver)

Merci beaucoup pour votre aide.
Je suis arrivé au résultat que je souhaitais.

Pour ceux que ça intéresse, voici le code en question:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_beforedoubleclick(ByVal Target As Range, cancel As Boolean)
Dim wbMyWb As Workbook
Dim Nom_Fichier As Variant
 
Application.ScreenUpdating = False
 
If ActiveCell.Address <> "$B$2" Then Exit Sub
 
Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsm,")
 
If Nom_Fichier = False Then
Exit Sub
End If
 
If Nom_Fichier <> False Then
   Set wbMyWb = Workbooks.Open(Nom_Fichier)
  wbMyWb.Activate
End If
 
 
Dligne = Range("B50000").End(xlUp).Row
 
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 1).Value = wbMyWb.ActiveSheet.Range("B4").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 5).Value = wbMyWb.ActiveSheet.Range("B5").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 4).Value = wbMyWb.ActiveSheet.Range("B6").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 2).Value = wbMyWb.ActiveSheet.Range("B8").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 8).Value = wbMyWb.ActiveSheet.Range("B9").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 6).Value = wbMyWb.ActiveSheet.Range("B10").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 7).Value = wbMyWb.ActiveSheet.Range("B11").Value
Workbooks("Opti flux MIA BORSA").Sheets("Feuil1").Cells(Dligne + 1, 3).Value = wbMyWb.ActiveSheet.Range("B12").Value
 
wbMyWb.Close
 
 
Application.ScreenUpdating = True
 
End sub

Bonne journée !