VBA : Modification d'une macro pour selection de fichier

Bonjour à tous

Je suis actuellement en train de plancher sur une macro qui me permettrait de récupérer les données de l'onglet "Recap" de plusieurs fichiers Excel situés dans un répertoire. Les noms des fichiers est obligatoirement différents (pas de fichier1, fichier2 par exemple mais plutôt "controle_agent41_octobre", "controle_agentXU_octobre", la nomenclature change en fonction de l'auteur du fichier...)

J'ai plusieurs répertoires fonctionnant de cette façon. Cela concerne une consolidation mensuelle de différents "contrôle qualité" de plusieurs services tout simplement.

Pour l'instant (et grâce ) au site wikiversity, j'ai choppé cette macro que j'ai adapté à mon besoin.

Sub consolidation_regroupement()

'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
Application.ScreenUpdating = False

'Détermine le chemin d'accès aux fichiers
Dim chemin As String
Dim fichier As String
Dim extension As String

chemin = "D:\Downloads\test\"
fichier = "test"
extension = ".xlsx"

'Indique le nombre de fichiers à consolider
nbfichiers = 2

   For i = 1 To nbfichiers

   'Ouvre le fichier à consolider
    Workbooks.Open (chemin & fichier & i & extension)

    'Sélectionne la feuille où se trouvent les données
    Sheets("Recap").Select

    'Compte le nombre de lignes à copier
    n = WorksheetFunction.CountA(Range("B:B"))

    'Compte le nombre de colonnes à copier
    m = ActiveSheet.UsedRange.Columns.Count

    'Copie les données
    Range(Cells(2, 1), Cells(n, m)).Copy

    'Active le classeur de synthèse
    'Windows("Synthese.xlsm").Activate
    ThisWorkbook.Activate

    'Sélectionne la feuille où on va coller les données
    Sheets("Recap2").Select

    'Compte le nombre de lignes non vides et ajoute 1 pour avoir le numéro de la première ligne vide
    c = WorksheetFunction.CountA(Range("A:A")) + 1

    'Sélectionne la première cellule vide
    Range("A" & c).Select

    'Colle les données
    ActiveSheet.Paste

    'Ferme la base de données qui a été consolidée et passe à la suivante
    Windows(fichier & i & extension).Close

    Next i

'Réactive l'actualisation de l'écran
Application.ScreenUpdating = True

End Sub

Elle fait ce dont j'ai besoin, à savoir mettre dans l'onglet du classeur utilisé les données des fichiers spécifiés dans la macro.

Le probleme c'est que les indications sont entrées "en dur" dans la macro, ce qui est finalement pas pratique à utiliser.

chemin = "D:\Downloads\test\"
fichier = "test"
extension = ".xlsx"

'Indique le nombre de fichiers à consolider
nbfichiers = 2

   For i = 1 To nbfichiers

Du coup, j'ai cherché comment remplacer le problème de selection de répertoire ainsi que de selection de fichiers (noms différents et l'extension pourrait également être hétérogène).

Voici les codes que j'ai pu dénicher sur gcexcel :

1 - Faire apparaître une fenêtre de sélection de répertoire qui m'intéresse :

Function ChoisirRepertoire() As String
Dim oFolder As Object
ChoisirRepertoire = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
If (Not oFolder Is Nothing) Then ChoisirRepertoire = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

2 - Sélection multiples de fichiers :

Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean

    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

Mais impossible à tout mettre en mettre en place, ca foire car la macro de base à besoin d'un nom de fichier et du nom de répertoire (en l'etat, la sélection de répertoire n'inclut pas le "\", ce qui semble causer une erreur).

Et enfin, lorsque j'utilise la macro sans aucune modification sale de ma part, je tombe sur ce message à chaque fichier ouvert

1

C'est possible de le faire disparaitre?

Est ce que quelqu'un pourrait me filer un coup la dessus s'il vous plait ?

Merci beaucoup !

Salut Kev,

Tu peux tenter un

Application.DisplayAlerts = False

Tu ne devrais plus avoir ce message mais par contre ton presse papier va grossir de plus en plus.

N'oublie pas de le remettre à true à la fin de la macro

Sinon tu vide toi même le presse papier, je n'ai pas cherché plus que ça mais avec le code suivant cela le fait:

Application.CutCopyMode = False

Il y a un sujet sur le site déjà il me semble :

https://forum.excel-pratique.com/excel/vider-le-presse-papiers-avec-vba-t16185.html

ECG

Salut

Voici le code trouvé pour vider le presse papier

Sub ViderPressePapier()
'Nécéssite d'activer la référence "Microsoft Forms 2.0 Object Library."
Dim Cible As dataObject

Set Cible = New dataObject
Cible.setText ""
Cible.putInClipboard

Set Cible = Nothing
End Sub

La référence est déjà active dans ma configuration d'Excel, je n'ai plus qu'a ajouter cet appel en fin de marcro !

Merci! J'y insert le message pour stopper les avertissements et voila ca passe !

edit : bon finalement

 Application.CutCopyMode = False 

fonctionne tres bien, l'autre code me dit que la "Cible As dataObject" est un type défini non défini par l'utilisateur.

Bref, le probleme du presse-papier est réglé !

Bon je ne sais pas si on avance mais on en est la

'module de taf au 20-11-17
Sub consolidation_regroupement_test()

'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
Application.ScreenUpdating = False

 'On supprime le message concernant le presse papier
 Application.CutCopyMode = False

' Supprime l'alerte concernant les donnees du presse-papier
Application.DisplayAlerts = False
 Application.CutCopyMode = False

'Détermine le chemin d'accès aux fichiers
Dim chemin As String
Dim fichier As String
Dim extension As String

chemin = "C:\ZONE06\test\"
fichier = "test"
extension = ".xlsx"

'Indique le nombre de fichiers à consolider (donc fichier1 puis fichier2 etc)
nbfichiers = 2

   For i = 1 To nbfichiers

   'Ouvre le fichier à consolider
    Workbooks.Open (chemin & fichier & i & extension)

    'Sélectionne la feuille où se trouvent les données
    Sheets("Recap").Select

    'Compte le nombre de lignes à copier
    N = WorksheetFunction.CountA(Range("B:B"))

    'Compte le nombre de colonnes à copier
    m = ActiveSheet.UsedRange.Columns.Count

    'Copie les données
    Range(Cells(2, 1), Cells(N, m)).Copy

    'Active le classeur de synthèse
    'Windows("Synthese.xlsm").Activate
    ThisWorkbook.Activate

    'Sélectionne la feuille où on va coller les données
    Sheets("Recap2").Select

    'Compte le nombre de lignes non vides et ajoute 1 pour avoir le numéro de la première ligne vide
    c = WorksheetFunction.CountA(Range("A:A")) + 1

    'Sélectionne la première cellule vide
    Range("A" & c).Select

    'Colle les données
    ActiveSheet.Paste

    'Ferme la base de données qui a été consolidée et passe à la suivante
    Windows(fichier & i & extension).Close

    Next i

'Réactive l'actualisation de l'écran
Application.ScreenUpdating = True

End Sub

mais ca bug sur

    'Ferme la base de données qui a été consolidée et passe à la suivante
    Workbooks(Selectionner_Fichiers(i)).Close
    Next i

en me disant que : L'indice n'appartient pas à la selection

meme constat avec

    'Ferme la base de données qui a été consolidée et passe à la suivante
     Windows(fichier & i & extension).Close
    Next i

C'est... compliqué !

Salut,

Tu as un peu avancé c'est déja bien

Tu avais le bug avant ou c'est tout nouveau?

Tu as juste un soucis de boucles/indices par rapport au nom de tes fichiers

tu as bien tes fichiers :

"C:\ZONE06\test\test1.xlsx" et "C:\ZONE06\test\test2.xlsx" qui existent? au bon endroit avec les bonnes majuscules/minuscules?

Tu ne les ouvres pas toi même avant quand tu test la macro? si c'est déjà ouvert je pense que ça fait une erreur ^^

Edit: essaye aussi avec "c:" et pas "C:", je ne sais pas si c'est sensible à la casse sur le chemin d'accès hmm

ECG

C'est bon, la ça fonctionne

Sub consolidation_regroupement_Jo()

'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
Application.ScreenUpdating = False

 'On supprime le message concernant le presse papier
 Application.CutCopyMode = False

    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
   Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)

    For i = LBound(Selectionner_Fichiers) To UBound(Selectionner_Fichiers)

   'Ouvre le fichier à consolider
    Workbooks.Open (Selectionner_Fichiers(i))
    'Sélectionne la feuille où se trouvent les données
   Sheets("Recap").Select

    'Compte le nombre de lignes à copier
   N = WorksheetFunction.CountA(Range("B:B"))

    'Compte le nombre de colonnes à copier
   m = ActiveSheet.UsedRange.Columns.Count

    'Copie les données
   Range(Cells(2, 1), Cells(N, m)).Copy

    'Active le classeur de synthèse
   'Windows("Synthese.xlsm").Activate
   ThisWorkbook.Activate

    'Sélectionne la feuille où on va coller les données
   Sheets("Recap2").Select

    'Compte le nombre de lignes non vides et ajoute 1 pour avoir le numéro de la première ligne vide
   c = WorksheetFunction.CountA(Range("A:A")) + 1

    'Sélectionne la première cellule vide
   Range("A" & c).Select

    'Colle les données
   ActiveSheet.Paste

    'Ferme la base de données qui a été consolidée et passe à la suivante
    Workbooks(Dir(Selectionner_Fichiers(i))).Close
    Next i

'Réactive l'actualisation de l'écran
Application.ScreenUpdating = True
 'On supprime le message concernant le presse papier
 Application.CutCopyMode = False

End Sub

Le seul probleme : la gestion du presse papier, le message s'affiche de nouveau !

Salut,

Hmm le

Application.CutCopyMode = False

ne supprime pas les messages du presse papier, ça le vide surtout dans notre cas, il faudrait regarder à nouveau l'aide d'excel pour savoir en détail.

Bref et avec un

Application.DisplayAlerts = False

en début de code, cela dit quoi?

ECG

Salut, désolé du temps de réponse, la semaine fut chargée de ouf, la fin de l'année arrivant à grand pas, il faut tout mettre en place pour la nouvelle année dans l'urgence (comme tous les ans... )

Bon voila la version pratiquement définitive

Sub consolidation_regroupement()
    'Stoppe l'actualisation de l'écran. Cela sert à masquer les actions de la macro
    Application.ScreenUpdating = False

    Selectionner_Fichiers = Application.GetOpenFilename("Fichiers Excel (*.xls*), *.xls*,Tous (*.*),*.*", 1, "Sélectionnez les fichiers", "Ouvrir", True)
    'feuille de destination
    Set dstsheet = ThisWorkbook.Sheets("Recap2")

    For i = LBound(Selectionner_Fichiers) To UBound(Selectionner_Fichiers)
        'Ouvre le fichier à consolider
        Set x = Workbooks.Open(Selectionner_Fichiers(i))
        'on vérifie que l'onglet 'recap' existe
        sheetExists = False
        For Each csheet In Worksheets
            If LCase(csheet.Name) = "recap" Then
                sheetExists = True
                Exit For
            End If
        Next csheet
        If sheetExists = False Then
            Workbooks(Dir(Selectionner_Fichiers(i))).Close
            MsgBox "L'onglet Recap n'existe pas dans " & Selectionner_Fichiers(i), vbOKOnly + vbExclamation, "Attention!"
        Else
            'feuille source
            Set srcsheet = x.Sheets("Recap")
            'Compte le nombre de lignes à copier
            N = Application.WorksheetFunction.CountA(srcsheet.Range("B:B"))
            'Compte le nombre de colonnes à copier
            m = srcsheet.UsedRange.Columns.Count
            'Compte le nombre de lignes non vides et ajoute 1 pour avoir le numéro de la première ligne vide
            c = WorksheetFunction.CountA(dstsheet.Range("A:A")) + 1
            'Copie
            dstsheet.Range(dstsheet.Cells(c, 1), dstsheet.Cells(c + N - 1, m)).Value = srcsheet.Range(srcsheet.Cells(2, 1), srcsheet.Cells(N + 1, m)).Value
            'Ferme la base de données qui a été consolidée et passe à la suivante
            Workbooks(Dir(Selectionner_Fichiers(i))).Close
        End If
    Next i
    'Réactive l'actualisation de l'écran
    Application.ScreenUpdating = True
End Sub

elle doit etre enregistrée dans le fichier XLSM (et non pas dans son fichier perso de macro).

La elle fonctionne, merci à mon cousin !

Je laisse à dispo pour tout ceux qui auront le même besoin que besoin (qui semble être fréquent d'ailleurs!).

Merci les mecs pour votre aide également !

Rechercher des sujets similaires à "vba modification macro selection fichier"