Intégrer une macro Excel dans Access (VBA) [Résolu/Fermé]

Signaler
-
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
-
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

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
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
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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
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  

Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
:) 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
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
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.
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
je sais pas faudrait que je demande si je peut
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 :)
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
Voir mon commentaire précédant.
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
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
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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.
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 !
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
Et.. tu à terminer ? ça marche à partir d'access ?
oui c'est bon c'est impeccable
merci encore une fois
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 167
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+