Bonjour ,
S'il vous plait j'ai un petit probléme , j'ai fait un programme qui permet d'extraire des cellules d'une feuilles xls bien particulier dans une table Access, mais le probléme qu'il me stoke tous les cellules dans cette table , voilà le code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
function IMPORT_MAQ_TEST()
 
 
'Ici l'importation se déclenche en cliquant sur le bouton "Commande1"
'mais on peut aussi mettre ce code à l'ouverture d'un formulaire
Dim oApp As Excel.Application
Dim oWkb As Excel.Workbook
Dim oWSht As Excel.Worksheet
Dim oWSht2 As Excel.Worksheet
 
 
Set oApp = CreateObject("Excel.Application")
Set oWkb = oApp.Workbooks.Open("C:\Documents and Settings\cer5490111\Bureau\Contrôle TP69 PCN064_CER54") 'mettez ici le chemin vers votre fichier Excel
Set oWSht2 = oWkb.Worksheets("Conversion TP69 Etat 1 à 8") 'mettez ici le nom de la feuille qui contient les données à importer
 
 
 
'première ligne ou commence l'import
Dim I As Integer
Dim J As Integer
 
Dim A
 
Dim cSQL2 As String
Dim chaine As String
 
 A = REQ_EXEC("MAQ_RECAP1_DEL")
 
I = 8
 
 
'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False
 
'tant qu'on n'est pas arrivés à la ligne 600 du tableur
While (oWSht2.Cells(I, 1) )<> ""
 
If oWSht2.Cells(I, 1).Value = "S" Then
 
cSQL2 = "insert into [MAQ_RECAP1_TAB]( [ID_MODIF1] ) values (" & Chr(34) & oWSht2.Cells(I, 1) & Chr(34) & ");"
 
DoCmd.RunSQL cSQL2
 
 
End If
I = I + 1
 
Wend
DoCmd.SetWarnings True
Set oWSht2 = Nothing
Set oWkb = Nothing
Set oApp = Nothing
 
 
 
Exit_IMPORT_MAQ_TEST:
    Exit Function
 
Err_IMPORT_MAQ_TEST:
       Resume Next
    MsgBox Error$
 
Resume Next
End Function