Intégrer une macro Excel dans Access (VBA)

Résolu
Bonjour,

Voila je vais tenter de vous expliquer mon problème.
J'ai un fichier Excel (.xls) dans lequel j'ai des tables, à ce fichier j'applique une macro sous Excel qui enfaite nous permet de filtrer les tables et de prendre seulement celle dont on a besoin.
Une fois cette macro appliqué j'enregistre le fichier et je l'importe dans ma base de donnée Access via un bouton qui à était codé sous VBA.

Je voulais savoir si il était possible de simplifier les manipulations en faisant en sorte qu'au moment de l'importation dans Access la macro Excel s'exécute en interne dans Access (avec VBA notamment) et qu'on est pas besoin de l'exécuter manuellement en ouvrant le fichier .xls

Merci d'avance

16 réponses

  1. Contributeur
    Bonjour,
    Comment veux-tu que du code qui est dans Excel s'exécute dans Access ?
    Quand tu est dans Excel tu doit ouvrir une instance d'Access et l'inverse serait aussi vrai, si tu est dans Access tu devrais ouvrir une instance d'Excel
    Ou alors j'ai pas bien compris.
    A+
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    NOTE : Je ne répond pas aux MP pour les questions techniques.
    0
    1. Oui c'est peut être infaisable (VBA n'est pas mon fort) mais y'aurait t-il une solution pour sauter l'étape de la macro (qui filtre juste les table) et que l'utilisateur n'est plus qu'a sélectionner le fichier Excel à importer ?

      Et merci d'avoir pris le temps de lire
      0
      1. Contributeur
        En te relisant..
        Tu a une macro dans Excel qui met tes tables en forme. Tu sauve et tu ferme.
        Ensuite..
        Tu a une macro dans Access qui ouvre CE fichier et importe.. ce que tu a besoin. ??
        Si c'est bien comme ça.
        Pas difficile de tout faire en une seule macro dans Access.
        Commencer ta macro dans Access par voir cette démo faire les mises en forme dans Excel et continuer par l'importation (ta macro Acess).
        Note : remplacer dans le code de la macro Excel tout ce qui fait appel au classeur par Book.
        Si tu n'en sort pas poste le code qui est dans Excel je verrais pour te l'adapter.
        Tu dis
        0
        1. C'est la macro Excel qui garde seulement les colonnes dont j'ai besoin et ensuite Access importe toutes les colonnes dans une table

          Voila le code de la macro Excel :

          Sub Référentiel()  
          
              Range("A:A,B:B,C:C,D:D,E:E,G:G").Select  
              Range("G1").Activate  
              ActiveWindow.SmallScroll ToRight:=5  
              Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N").Select  
              Range("N1").Activate  
              ActiveWindow.LargeScroll ToRight:=1  
              Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB").Select  
              Range("AB1").Activate  
              ActiveWindow.LargeScroll ToRight:=1  
              Range( _ "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU" _  
                  ).Select  
              Range("AU1").Activate  
              ActiveWindow.SmallScroll ToRight:=7  
              Range( _  
          "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU,AV:AV,AW:AW,AX:AX,AY:AY" _  
                  ).Select  
              Range("AY1").Activate  
              ActiveWindow.SmallScroll ToRight:=5  
              Range( _  
          "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU,AV:AV,AW:AW,AX:AX,AY:AY,BD:BD,BF:BF" _  
                  ).Select  
              Range("BF1").Activate  
              Selection.Copy  
              Sheets.Add  
              ActiveSheet.Paste  
              Sheets("EXP").Select  
              Application.CutCopyMode = False  
              ActiveWindow.SelectedSheets.Delete  
              Selection.Replace What:="    ", Replacement:="", LookAt:=xlPart, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Selection.Replace What:="Rattach ", Replacement:="", LookAt:=xlPart, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Selection.Replace What:="  ", Replacement:="", LookAt:=xlWhole, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Selection.Replace What:="   ", Replacement:="", LookAt:=xlWhole, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Columns("M:N").Select  
              Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Columns("O:O").Select  
              Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _  
                  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                  ReplaceFormat:=False  
              Range("G1").Select  
              ActiveCell.FormulaR1C1 = "Code Rattachement ZMVN/QS"  
              Range("H1").Select  
              ActiveCell.FormulaR1C1 = "Nom Rattachement ZM VN/QS"  
              Range("I1").Select  
              ActiveCell.FormulaR1C1 = "Code CAR de rattachement"  
              Range("J1").Select  
              ActiveCell.FormulaR1C1 = "Nom CAR de rattachement"  
              Range("A1").Select  
          End Sub  
          
          
          0
          1. Contributeur
            Wouaaa, c'est du pure éditeur de macro.. :-)
            Faut vraiment optimiser ça.
            Je commente déjà ce début...

              Range("A:A,B:B,C:C,D:D,E:E,G:G").Select  'tu sélectionne ces colonnes mais tu fais rien.  
                Range("G1").Activate  Tu active cette cellule mais tu fais rien  
                ActiveWindow.SmallScroll ToRight:=5  'ça c'est quand tu scrool la feuille   
                Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N").Select  'la tu fais rien non plus  
                Range("N1").Activate   'la tu fais rien non plus  
                ActiveWindow.LargeScroll ToRight:=1    
                Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB").Select   'la tu fais rien non plus  
                Range("AB1").Activate   'la tu fais rien non plus  
                ActiveWindow.LargeScroll ToRight:=1    'ça c'est quand tu scrool la feuille

            Conclusion TOUTES CES LIGNES NE SERVENT A RIEN.
            Tu peu supprimer toutes les lignes ci-dessous elles servent à rien
              Range("A:A,B:B,C:C,D:D,E:E,G:G").Select    
                Range("G1").Activate    
                ActiveWindow.SmallScroll ToRight:=5    
                Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N").Select    
                Range("N1").Activate    
                ActiveWindow.LargeScroll ToRight:=1    
                Range("A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB").Select    
                Range("AB1").Activate    
                ActiveWindow.LargeScroll ToRight:=1    
                Range( _ "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU" _    
                    ).Select    
                Range("AU1").Activate    
                ActiveWindow.SmallScroll ToRight:=7    
                Range( _    
            "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU,AV:AV,AW:AW,AX:AX,AY:AY" _    
                    ).Select    
                Range("AY1").Activate    
                ActiveWindow.SmallScroll ToRight:=5

            Tout les select peuvent être supprimer, exemple
            Range("G1").Select    
                ActiveCell.FormulaR1C1 = "Code Rattachement ZMVN/QS"

            Remplacer par
                Range("G1") = "Code Rattachement ZMVN/QS"

            Tu a regardé la démo ?
            Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
            NOTE : Je ne répond pas aux MP pour les questions techniques.
            0
            1. :) effectivement comme tu la dis beaucoup de ligne ne servait a rien

              Voila la version allégé :)

              Sub Référentiel()
              
                  Range( _
              "A:A,B:B,C:C,D:D,E:E,G:G,M:M,N:N,U:U,V:V,Y:Y,AB:AB,AN:AN,AO:AO,AP:AP,AR:AR,AT:AT,AU:AU,AV:AV,AW:AW,AX:AX,AY:AY,BD:BD,BF:BF" _
                      ).Select
                  Range("BF1").Activate
                  Selection.Copy
                  Sheets.Add
                  ActiveSheet.Paste
                  Sheets("EXP").Select
                  Application.CutCopyMode = False
                  ActiveWindow.SelectedSheets.Delete
                  Selection.Replace What:="    ", Replacement:="", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Selection.Replace What:="Rattach ", Replacement:="", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Selection.Replace What:="  ", Replacement:="", LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Selection.Replace What:="   ", Replacement:="", LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Columns("M:N").Select
                  Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Columns("O:O").Select
                  Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=False
                  Range("G1") = "Code Rattachement ZMVN/QS"
                  Range("H1") = "Nom Rattachement ZM VN/QS"
                  Range("I1") = "Code CAR de rattachement"
                  Range("J1") = "Nom CAR de rattachement"
                  Range("A1").Select
              End Sub
              


              ensuite j'ai regardé aussi la démo mais je n'ai pas réussi a faire le lien avec mon problème ( comme tu l'as constater VBA c'est pas mon truc :) )

              par contre j'ai trouvé sa et je sais pas si sa peut m'aider :

              DoCmd.TransferSpreadsheet acImport, 8, "Employés","C:\Fichier.xls", True, "A1:G12" 


              je me demandé si c'était possible que je puisse sélectionner seulement les colonnes que j'ai besoin pendant l'importation. En l'occurrence les colonnes A,B,C,D,E,G,M,N,...,BF
              0
              1. Contributeur
                DoCmd Ça peu pas beaucoup t'aider d'après ce que je vois de ta macro.
                Ta macro peu être réduire à quelque lignes mais il faut plus d'indications.
                1°)Tu copie un certain nombre de colonne que tu veux copier dans une nouvelles feuille ?
                2°) Les colonnes que tu sélectionne sont dans quel feuille (le nom)
                3°) tu supprime la feuille EXP ?
                4°) Ensuite tu enlève les " " les " " les . et les , dans certaine colonne ?
                5°) Tout se passe dans le même classeur ? et donne sont nom
                Rectifie mes déductions, je verrais si je peu optimiser
                Ensuite met la macro qui est dans ACCESS
                Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
                NOTE : Je ne répond pas aux MP pour les questions techniques.
                0
                1. Désolé pour le temps de réponse mais étant en entreprise seulement les jeudis et vendredis je n'ai pas eu accès au code

                  Pour en revenir au sujet et répondre a tes questions tout d'abord j'ai bien un fichier qui se nomme EXP.xls qui contient une seule feuille qui se nomme exp.

                  La macro Excel supprime les colonnes, les espaces, le mot Rattach et dans certaines colonne qui contiennent le numéro de téléphone et de fax les '.' ou les ' ' qui sépare les numéros sont effacer et de même pour les numéros de voie on efface les 0

                  Une fois la macro effectuer je n'est plus ma feuille exp mais une nouvelle feuille qui est nommé Feuil1 et que j'enregistre sous Structure.xls et c'est ce fichier Structure.xls que j'importe dans Access

                  Ensuite sur Access j'ai un bouton intégration puis je sélectionne le fichier Structure.xls et je met les données dans une table Temp-Structure(qui contient le même nombre de colonne et les même noms) et la j'exécute une macro(Integration RRF) qui mettra a jour ma base de donnée voila le code du bouton :

                  Private Sub Commande39_Click()
                      Dim fd As FileDialog
                      Set fd = Application.FileDialog(msoFileDialogFolderPicker)
                      Dim vrtSelectedItem As Variant
                      With fd
                          If .Show = -1 Then
                              For Each vrtSelectedItem In .SelectedItems
                                  DoCmd.SetWarnings False
                                  DoCmd.RunSQL "Delete * From [Temp-Structure]"
                                  DoCmd.RunSQL "Delete * From [Temp-Ville]"
                                  DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel9, "Temp-Structure", "Structure.xls", True
                                  DoCmd.RunMacro "Intégration RRF"
                                  DoCmd.RunSQL "Delete * From [Temp-Structure]"
                                  DoCmd.RunSQL "Delete * From [Temp-Ville]"
                                  DoCmd.SetWarnings True
                                  MsgBox "Importation terminée"
                              Next vrtSelectedItem
                          'The user pressed Cancel.
                          Else
                          End If
                      End With
                  
                      'Set the object variable to Nothing.
                      Set fd = Nothing
                  
                  End Sub
                  


                  Je ne sais pas comment te faire parvenir ma macro Integration RRF car c'est un tas de requête SQL (13 au total).

                  Mais je pense que cette macro ne pose pas problème.

                  Voila je suis a ta disposition si ta encore des questions
                  Et encore une fois désolé d'avoir mis du temps a te répondre.
                  0
                  1. Contributeur
                    Re,
                    1°) voir cette démo
                    2°) Dans EXCEL, faire une nouvelle macro qui fonctionne suivant le principe de la démo. J'ai testé sur Excel et ça fonctionne aussi. (Excel créant Excel :-) )
                    Ajouter en début de la sub
                    Dim EX, Book, Feuille

                    Supposons le nom de la nouvelle macro AppelerExcel
                    3°) Quand tout fonctionne avec le nouveau code, copier/coller la nouvelle sub dans Access.
                    4°) Dans Access pas oublier de cocher la référence Microsoft Excel X,X object librairy
                    5°) Dans Private Sub Commande39_Click() ajouter juste en dessous AppelerExcel
                    Tu dis jusqu'où tu comprend.
                    0
                    1. Contributeur
                      Si ton classeur EXP.xls ne contient pas de donnée confidentiel tu pourais le déposer sur Cjoint.com ? Je verais pour optimiser la macro parce que ton système avec copie me semble un peu... lourd.
                      0
                    2. je sais pas faudrait que je demande si je peut
                      0
                  2. D'accord je vais essayer de faire une macro en fonction de la démo puis je reviendrais vers toi pour te dire si ça va ou pas :)
                    0
                    1. Contributeur
                      Voir mon commentaire précédant.
                      0
                  3. Contributeur
                    Une petite aide ??
                    Ouvrir un nouveau classeur.
                    dans un module coller le code ci-dessous
                    Sub Référentiel() 
                    Dim TB, i As Integer, Plage As Range 
                    Dim DerCol As Integer 
                    Dim DerLig As Long 
                    Dim EX, Book, Feuille 
                        Set EX = CreateObject("Excel.application") 
                        EX.Visible = True 
                        Set Book = EX.Workbooks.Open("C:\Test\exp.xls") 
                        Set Feuille = Book.Sheets("EXP") 
                        EX.DisplayAlerts = False 
                        TB = Array("F", "H:L", "O:T", "W:X", "Z:AA", "AC:AM", "AQ:AS", "AZ:BC", "BE") 
                        With Feuille 
                            For i = UBound(TB) To 0 Step -1 
                                .Columns(TB(i)).Delete 
                            Next 
                            DerLig = .Range("A1").SpecialCells(xlCellTypeLastCell).Row 
                            DerCol = 35 
                            .Name = "Feuil1" 
                            Set Plage = .Range(.Cells(1, 1), .Cells(DerLig, DerCol)) 
                            For i = 1 To 4 
                                Plage.Replace What:=Space(i), Replacement:="", LookAt:=xlPart, _ 
                                    SearchOrder:=xlByRows 
                            Next 
                            Plage.Replace What:="Rattach", Replacement:="", LookAt:=xlPart, _ 
                                SearchOrder:=xlByRows 
                                 
                            .Range(.Cells(1, 15), .Cells(DerLig, 15)).Replace What:="0", Replacement:="", LookAt:=xlWhole, _ 
                                SearchOrder:=xlByRows 
                             
                            .Range("G1") = "Code Rattachement ZMVN/QS" 
                            .Range("H1") = "Nom Rattachement ZM VN/QS" 
                            .Range("I1") = "Code CAR de rattachement" 
                            .Range("J1") = "Nom CAR de rattachement" 
                            .Range("A1").Select 
                        End With 
                        Book.SaveAs "C:\test\Structure.xls" 
                        Book.Close 
                        EX.Quit 
                        Set Feuille = Nothing 
                        Set Book = Nothing 
                        Set EX = Nothing 
                    End Sub

                    Comme je n'ai pas le modèle, possible que les colonnes ne soient pas tout à fait juste, vérifie.
                    Sinon la macro fonctionne impec.
                    Oublie pas de rectifier le nom du chemin des répertoires
                    Ceci répond au poste 2 des directives précédentes.
                    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
                    NOTE : Je ne répond pas aux MP pour les questions techniques.
                    0
                    1. Merci beaucoup elle fonctionne :) !
                      le seul soucis que j'ai c'est que elle efface tout les espace ce qui donne par exemple :

                      Codeentité au lieu de Code entité

                      Alors que elle devrait effacer les cellules contenant seulement des espaces

                      j'ai essayer de rectifier mais sans réussite
                      0
                      1. Contributeur
                        pourtant tu met sur toute la feuille..
                        Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _  
                                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _  
                                ReplaceFormat:=False  
                        

                        Donc c'était comme ça avant !!
                        C'est quel colonne ?
                        EDIT :
                        Dans la première boucle... LookAt:=xlPart
                        tu dis.
                        Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
                        NOTE : Je ne répond pas aux MP pour les questions techniques.
                        0
                        1. C'est bon j'ai réussi comme tu me l'as fait remarquer il fallait bien mètre les LookAt

                          Merci grandement de ton aide lermite222 !
                          0
                          1. Contributeur
                            Et.. tu à terminer ? ça marche à partir d'access ?
                            0
                            1. oui c'est bon c'est impeccable
                              merci encore une fois
                              0
                              1. Contributeur
                                Tant mieux, mais pour une prochaine fois, si tout baigne marque le topic en résolu Stp.
                                Le lien au dessus à gauche de ta question initiale.
                                A+
                                0

                            Discussions similaires

                            Quick Access service

                            4 réponses