bonjour,
no problemo. Volà tout le code
Sub achat()
' ********************************************************************************
' recherche fichier excel sur le réseau par l'exporateur
' remplissage d'une table Access à partir des données du fichier Excel
' ********************************************************************************
Dim Fd As FileDialog
Dim Fdfs As FileDialogFilters
Dim Fdf As FileDialogFilter
Dim VrtSelectedItem As Variant
Dim test As Variant
' variables de la table tab_prix_achat_budget
Dim Cnn_db As New ADODB.Connection
Dim Rst_db As New ADODB.Recordset
' ouverture de la connection au fichier EXCEL
Dim Cnn_ex As New ADODB.Connection
Dim Rst_ex As New ADODB.Recordset
' choix du fichier Excel par l'explorateur
Set Fd = Application.FileDialog(msoFileDialogOpen)
Set Fdfs = Application.FileDialog(msoFileDialogOpen).Filters ' collection des extensions
Fdfs.Clear ' destruction de la liste des extensions
Set Fdf = Fdfs.Add("Excel", "*.xls", 1) ' ajout de la seule extension Excel
' récupération du nom et du chemin du fichier sélectionné
With Fd
.AllowMultiSelect = False ' multisélection interdite
If .Show = -1 Then
path = .SelectedItems(1)
Else
'The user pressed Cancel.
Exit Sub
End If
End With
Set Fd = Nothing
'ouverture de la connection à la table "tab_prix_achat_budget" ACCESS
Set Cnn_db = CurrentProject.Connection
Rst_db.Open "tab_prix_achat_budget", Cnn_db, adOpenKeyset, adLockOptimistic
' création de la zone nommée dans le fichier Excel
definition_zone
'ouverture de la connection au fichier EXCEL
With Cnn_ex
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Open path
End With
' lecture du fichier EXCEL
Set Rst_ex = New ADODB.Recordset
Rst_ex.Open "nom_de_zone", Cnn_ex, , , adCmdTable
Do Until Rst_ex.EOF
' ajout dans la table access
With Rst_db
If IsNumeric(Rst_ex.Fields("Artcode")) Then ' si le code article est renseigné
.AddNew Array("code article", "prix achat budget 1er tri", "prix achat budget 2ème tri", "prix achat budget 3ème tri", "prix achat budget 4ème tri"), _
Array(Rst_ex.Fields("Artcode"), Rst_ex.Fields("1 trim"), Rst_ex.Fields("2 trim"), Rst_ex.Fields("3 trim"), Rst_ex.Fields("4 trim"))
.Update
End If
End With
Rst_ex.MoveNext ' ligne suivante du tableau EXCEL
Loop
' fermeture des connections
Cnn_ex.Close
Cnn_db.Close
End Sub
Sub definition_zone()
' **************************************************************
' création d'une référence de zone dans un tableau Excel
' **************************************************************
Dim Feuille, Classeur As Variant
Dim Xls As Excel.Workbook
Dim colonne As Integer
Dim ligne As Integer
Dim ligne_début As Integer
Dim colonne_début As Integer
Set Xls = GetObject(path) 'ok
Xls.Application.Visible = True 'ok
Xls.Application.Windows(1).Visible = True 'ok
Xls.Application.ActiveWorkbook.Activate 'ok
Classeur = Xls.Application.ActiveWorkbook.Name 'ok
' nom de la feuille du classeur
Feuille = Xls.Application.Sheets(1).Name
' positionnement sur la dernière cellule du tableau
Xls.Application.Worksheets(1).Cells(1, 1).Select 'ok
Xls.Application.ActiveCell.SpecialCells(xlLastCell).Select 'ok
' initialisation du début
ligne_début = 1
colonne_début = 1
' numéro de colonne et de ligne de la dernière cellule
colonne = Xls.Application.ActiveCell.Column 'ok
ligne = Xls.Application.ActiveCell.Row 'ok
' composition de la référence de la zone à créer
Feuille = Feuille & "'!L" & ligne_début & "C" & colonne_début & ":L" & ligne & "C" & colonne ' ok
' création de la zone de référence
Xls.Application.ActiveWorkbook.Names.Add Name:="nom_de_zone", RefersToR1C1:= _
"='" & Feuille 'ok
Set Xls = Nothing
End Sub
Il te suffit d'ouvrir autant de Rts_db que tus de tables access pour, suivant les champs de Rst_ex alimenter l'une ou l'autre des tables Access
Colibri
|