Insertion fenêtre de choix dans une macro

Résolu/Fermé

Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023 - 24 nov. 2020 à 12:31
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 25 nov. 2020 à 11:26

Bonjour à tous,

Etant novice en VBA, je vous contacte car je ne sais pas comment appliquer mon idée dans ma macro.

Actuellement, j'ai une macro (qui fonctionne très bien) me permettant d'extraire les informations de plusieurs fichiers vers mon Excel cible.
Mais ma macro repose sur une boucle et le nombre de fichiers est important. (temps de la macro > 30min)

Mon idée est de pouvoir sélectionner un seul fichier et de lancer son extraction sans que les autres se fassent. Le tout en ouvrant une fenêtre permettant de choisir le fichier au sein de la liste présente dans l'excel cible (voir image).

Macro utilisée:

Sub MaJ_projet()
Dim Chemin As String, Fichier As String, Extraction As String, Résumé As String
Worksheets("Ajout de nouveaux projets").Select
For I = 4 To Range("a" & Rows.Count).End(xlUp).Row 'Départ à la ligne 4
If Range("a" & I) <> "" Then
    Worksheets("Ajout de nouveaux projets").Select 'Feuille où se trouve les chemins
    Chemin = Range("b" & I)
    Fichier = Range("c" & I)
    Extraction = Range("d" & I)
    Résumé = Range("a" & I)
    
    Set classeurProj = Application.Workbooks.Open(Chemin & Fichier, , True) 'Ouverture du fichier
    Set classeurDestination = ThisWorkbook
    With Worksheets("Materiels")
        If .FilterMode = True Then .ShowAllData 'Suppression des filtres existants
    End With
    classeurProj.Sheets("Materiels").Cells.Copy classeurDestination.Sheets(Extraction).Range("A1") 'Extraction des informations dans sa feuille spécifique
    classeurProj.Close False
   
End If

Next I

End Sub

Et un extrait de ma liste d'extraction

Merci d'avance

A voir également:

Insertion fenêtre de choix dans une macro
Liste déroulante de choix excel - Guide
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Insertion signature word - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur

4 réponses

Réponse 1 / 4

yg_be Messages postés 22730 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 1 477
24 nov. 2020 à 13:21

bonjour,
je pense que le plus simple serait que tu sélectionnes une des cellules de la liste, et que la macro travaille uniquement pour cette ligne.

Réponse 2 / 4

Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023
24 nov. 2020 à 13:36

Bonjour,

Oui c'est le but en passant par une fenêtre de choix reportant la liste.
La finalité est de lancer la nouvelle macro, On sélectionne la cellule via une fenêtre (qui affichera la liste) et que l'extraction se lance.

yg_be Messages postés 22730 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 26 avril 2024 1 477
24 nov. 2020 à 13:42

Je suggère de d'abord faire la sélection, puis de lancer la nouvelle macro.
La macro observera ce qui est sélectionné, et agira en conséquence.

Réponse 3 / 4

Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023
24 nov. 2020 à 14:10

Si on fait dans l'ordre que tu proposes, il faudra alors 2 macros, une pour la sélection et une pour l'extraction. N'est pas plus pratique de tout regrouper ?

Réponse 4 / 4

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
24 nov. 2020 à 14:20

Bonjour,

se mettre sur la feuille où se trouve les chemins des classeurs et faire Alt F11 pour accéder à l'éditeur.
Coller ce code qui se déclenchera au double clic dans la colonne B:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
Dim Chemin As String, Fichier As String, Extraction As String, Résumé As String
  Dim classeurProj As Workbook, classeurDestination As Workbook
    If Target.Value = "" Then Exit Sub
    Chemin = Range("b" & Target.Row)
    Fichier = Range("c" & Target.Row)
    Extraction = Range("d" & Target.Row)
    Résumé = Range("a" & Target.Row)
    Set classeurProj = Application.Workbooks.Open(Chemin & Fichier, , True) 'Ouverture du fichier
     Set classeurDestination = ThisWorkbook
    With Worksheets("Materiels")
        If .FilterMode = True Then .ShowAllData 'Suppression des filtres existants
    End With
    classeurProj.Sheets("Materiels").Cells.Copy classeurDestination.Sheets(Extraction).Range("A1") 'Extraction des informations dans sa feuille spécifique
    classeurProj.Close False
End If
End Sub

Voilà

Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023
24 nov. 2020 à 14:38

Bonjour,

J'ai suivi tes indications et ça ne fonctionne pas du tout. (Même pas d'ouverture de fichier)

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023
24 nov. 2020 à 14:59

Voir ceci pour l'ouverture d'un classeur

https://docs.microsoft.com/fr-FR/office/vba/api/Excel.Workbooks.Open

Inconnu404 Messages postés 24 Date d'inscription lundi 12 octobre 2020 Statut Membre Dernière intervention 31 octobre 2023 > cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024
Modifié le 24 nov. 2020 à 15:48

Je comprends pas ta réponse.
Ma macro de base fonctionne très bien avec cette écriture. Et il n'y a pas d'erreur.

Cela fonctionne chez moi. Vérifie le chemin , il doit manquer des éléments

essai ceci:

Sub test()
Dim Chemin As String, Fichier As String
  Dim classeurProj As Workbook, classeurDestination As Workbook
    Chemin = Range("b5")
    Fichier = Range("c5")
     Set classeurProj = Application.Workbooks.Open(Chemin & Fichier, , True) '
End Sub

Vérification de la macro Test : ça fonctionne et j'ouvre bien mon fichier.
En comparant avec ta première macro, aucune différence.
Le problème ne viendrait t-il pas de cette commande ?

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then

Discussions similaires

Conhost.exe

Discussions similaires

Newsletters