Problème importation Excel vers Access

[vince9535z]

Bonsoir ,
débutant dans access , je n'arrive pas à importer mon fichier excel dans access à cause des (.) dans les titres des colonnes.

J'ai une macro automatique lié à un bouton : voir pièce jointe


Pourriez-vous m'aider?

Cordialement

[tee_grandbois]

Bonsoir,
comme le point '.' est un caractère réservé, la seule solution est de les remplacer par un autre caractère (par exemple le souligné '_').

[vince9535z]

Merci pour votre réponse , mais je cherche à automatiser cette étape pour les utilisateurs et donc cela passe surement par une macro avec ouverture du fichier excel avant importation et suppression des points?

A votre avis?
Merci

[tee_grandbois]

Bonsoir,
tu peux remplacer les '.' par des '_' en exécutant rechercher/remplacer depuis Access avant l'importation de ton classeur :

Code :

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
Function importXls()
Dim objApp As Object
Dim objBook As Object
Dim objSheet As Object
Dim strFic As String
strFic = "C:\TonClasseur.xls"
 
    Set objApp = CreateObject("Excel.Application")
    Set objBook = objApp.workbooks.Open(strFic)
    Set objSheet = objBook.worksheets(1)
    objSheet.Activate
     With objSheet
        objApp.Rows("1:1").Select
        objApp.Selection.Replace What:=".", Replacement:="_", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End With
 
objBook.Save
objApp.Quit
 
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
 
End Function

à intégrer dans ta macro avec Exécuter code

[vince9535z]

je te remercie pour le code précédent , en revanche quand je clique sur le bouton avec le code , celui ci affiche une erreur voir (pièce jointe), il y a marqué "END SUB attendu" quand je lance la macro.


emplacement de mon fichier C:\Users\vincent\Desktop\FICHIER\BASE ACCESS\suivi_portefeuille.xls

Nom de la feuille dans excel "Listes des affaires" et dans le code Feuil12

les données d'entête sont sur la ligne 3
colonnes de A3 à FS3

Merci d'avance pour votre aide.

[tee_grandbois]

Bonsoir,
ce n'est pas ce qu'il faut faire, le code que je t'ai donné ne doit pas être placé tel quel dans le formulaire.
2 solutions :
1) enlève les deux instructions ci-dessous :

Code :

1
2
Function importXls()
End Function

2) Enlève tout le code du formulaire et enregistre et compile-le dans un module, ensuite appelle la fonction sur l'événement clic de ton formulaire comme ceci :

Code :

1
2
3
Private Sub Commande48_Click()
Call importXls
En Sub

ci-joint la base modifiée

[vince9535z]

un grand merci , j'arrive maintenant à supprimer les points à partir de mon bouton , maintenant il me reste à l'insérer dans ma macro d'import.

objApp.Rows("1:10000").Select , si j'ai bien compris cela marche en ligne?

mais franchement un grand merci encore une fois car j'étais dans la merde sans ton aide.

[tee_grandbois]

Bonsoir Vince9535z,
Je suis content d'avoir pu t'aider

objApp.Rows("1:10000").Select , si j'ai bien compris cela marche en ligne?

C'est bien çà, on indique la première ligne car, en général, c'est elle qui contient les entêtes de colonnes. Si tu mets "1:10000", il va enlever tous les '.' qu'il va trouver dans tes données jusqu'à la ligne 10000 : je ne pense pas que c'est ce que tu souhaites.

[vince9535z]

Je voudrais compacter ces 2 codes :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function M_IMPORT_T_PA_ATOT_MP()
On Error GoTo M_IMPORT_T_PA_ATOT_MP_Err

    DoCmd.Hourglass True
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "R SUPP T ATOT MP", acViewNormal, acEdit
    DoCmd.SetWarnings False
INSERTION 2IEME CODE (EN BAS DU MESSAGE)
    DoCmd.TransferSpreadsheet acImport, 8, "T ATOT MP", "C:\Users\vincent\Desktop\FICHIER\BASE ACCESS\suivi_portefeuille.xlsx", True, "Listes des affaires!A3:FS10000"
    DoCmd.Hourglass True
    DoCmd.SetWarnings False
    DoCmd.Hourglass True


M_IMPORT_T_PA_ATOT_MP_Exit:
    Exit Function

M_IMPORT_T_PA_ATOT_MP_Err:
    MsgBox Error$
    Resume M_IMPORT_T_PA_ATOT_MP_Exit

End Function

------------------------------------------------------

Code :

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
Private Sub Commande48_Click()
 
Dim objApp As Object
Dim objBook As Object
Dim objSheet As Object
Dim strFic As String
strFic = "C:\Users\vincent\Desktop\FICHIER\BASE ACCESS\suivi_portefeuille.xls"
 
 
    Set objApp = CreateObject("Excel.Application")
    Set objBook = objApp.workbooks.Open(strFic)
    Set objSheet = objBook.worksheets(12)
    objSheet.Activate
     With objSheet
        objApp.Rows("3:3").Select
        objApp.Selection.Replace What:=".", Replacement:=" "
    End With
 
objBook.Save
objApp.Quit
 
Set objSheet = Nothing
Set objBook = Nothing
Set objApp = Nothing
 
 
   End Sub