Discussion :

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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:




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 !

[Mickamax]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

Merci beaucoup !

[halaster08]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

   Set wbMyWb = Workbooks.Open(Nom_Fichier)

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Igloobel]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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:




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 !

Bonjour,

C'est normal

extrait de l'aide en ligne :

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+

[Mickamax]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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:



Mickamax

[halaster08]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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:

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

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

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)

[Mickamax]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !