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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
'voici les imports rien de bien special'
Imports System.Data
Imports System.Data.OleDb
Imports System.IO.File
Imports Microsoft.VisualBasic
Imports Microsoft.Office
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Public Class FImport
Dim Choix As String
Dim Chemin As String
Dim TextSql As String
Private Sub BImport_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BImportRamasse.Click
OpenFileDialog1.ShowDialog()
End Sub
Sub Importation()
'variables pour excel'
Dim appXls As Application
Dim sheetXls As Excel.Worksheet
'variable autres'
Dim x As Integer
Dim CodeSecteur As Integer
Dim CodePVT As Integer
Dim CodeUser As Integer
Dim NomUser As String
Dim jDebutPvt, mDebutPvt, yDebutPvt As Integer
Dim Temps As Integer
Dim QttRamasser, QttPrelevee, QttRuptee As Integer
Dim Productivite As Integer
Label1.Text = 0
Dim a As Integer = Me.Width
Dim b As Integer = Label1.Width
Dim c As Integer = (a - b) / 2
Label1.Left = c
' CODE RAJOUTER CE MATIN'
If (Chemin.ToLower().IndexOf("ventilation") > -1) Then
Choix = "Ventilation"
ElseIf (Chemin.ToLower().IndexOf("ramasse") > -1) Then
Choix = "Ramasse"
Else
MsgBox("ERREUR - Fichier inconnu, impossible de reconnaitre le fichier", MsgBoxStyle.OkOnly, "ERREUR")
End If
'FIN DU CODE RAJOUTER CE MATIN'
Select Case Choix
Case "Ramasse"
appXls = New Application 'ouverture d'excel
appXls.Visible = False 'on affiche la fenetre d'excel
appXls.Workbooks.Open(Chemin) 'ouverture du fichier excel
sheetXls = CType(appXls.ActiveWorkbook.Worksheets("Sheet1"), Worksheet) 'on selectionne la page "sheet1"
x = 2
Do While Trim(sheetXls.Range("A" & x).Value) <> "" '<----- LIGNE AVEC MESSAGE D'ERREUR
CodeSecteur = 0
CodePVT = 0
CodeUser = 0
NomUser = ""
Temps = 0
QttRamasser = 0
Productivite = 0
CodeSecteur = Trim(sheetXls.Range("A" & x).Value)
CodePVT = Trim(sheetXls.Range("B" & x).Value)
CodeUser = Trim(sheetXls.Range("C" & x).Value)
NomUser = Trim(sheetXls.Range("D" & x).Value)
jDebutPvt = Strings.Left(sheetXls.Range("E" & x).Value, 2)
mDebutPvt = Mid(sheetXls.Range("E" & x).Value, 4, 2)
yDebutPvt = Mid(sheetXls.Range("E" & x).Value, 7, 4)
Temps = sheetXls.Range("G" & x).Value
QttRamasser = sheetXls.Range("H" & x).Value
QttRuptee = sheetXls.Range("I" & x).Value
Productivite = sheetXls.Range("J" & x).Value
TextSql = "insert into ramasse (codesecteur, codepvt, codeuser, nomuser, jdebutpvt, mdebutpvt, ydebutpvt, temp, qttramasser, qttruptee, productivite) values ('" & CodeSecteur & "', '" & CodePVT & "', '" & CodeUser & "', '" & NomUser & "', " & jDebutPvt & ", " & mDebutPvt & ", " & yDebutPvt & ", " & Temps & ", '" & QttRamasser & "', '" & QttRuptee & "', '" & Productivite & "')"
'On Error GoTo Affiche
Dim CmdValeur As New OleDbCommand(TextSql, DBAccess)
CmdValeur.ExecuteNonQuery()
Label1.Text = x
x = x + 1
appXls.Quit()
Loop
Case "Ventilation"
appXls = New Application 'ouverture d'excel
appXls.Visible = False 'on affiche la fenetre d'excel
appXls.Workbooks.Open(Chemin) 'ouverture du fichier excel
sheetXls = CType(appXls.ActiveWorkbook.Worksheets("Sheet1"), Worksheet) 'on selectionne la page "sheet1"
x = 2
Do While Trim(sheetXls.Range("A" & x).Value) <> "" '<----- LIGNE AVEC MESSAGE D'ERREUR
CodeUser = 0
NomUser = ""
Temps = 0
QttPrelevee = 0
QttRuptee = 0
Productivite = 0
CodeUser = Trim(sheetXls.Range("A" & x).Value)
NomUser = Trim(sheetXls.Range("B" & x).Value)
jDebutPvt = Strings.Left(sheetXls.Range("C" & x).Value, 2)
mDebutPvt = Mid(sheetXls.Range("C" & x).Value, 4, 2)
yDebutPvt = Mid(sheetXls.Range("C" & x).Value, 7, 4)
Temps = sheetXls.Range("E" & x).Value
QttPrelevee = sheetXls.Range("F" & x).Value
QttRuptee = sheetXls.Range("G" & x).Value
Productivite = sheetXls.Range("H" & x).Value
TextSql = "insert into ventilation (codeuser, nomuser, jdebutpvt, mdebutpvt, ydebutpvt, temps, qttprelevee, qttruptee, productivite) values ('" & CodeUser & "', '" & NomUser & "', " & jDebutPvt & ", " & mDebutPvt & ", " & yDebutPvt & ", " & Temps & ", '" & QttPrelevee & "', '" & QttRuptee & "', '" & Productivite & "')"
'On Error GoTo Affiche
Dim CmdValeur As New OleDbCommand(TextSql, DBAccess)
CmdValeur.ExecuteNonQuery()
Label1.Text = x
x = x + 1
appXls.Quit()
Loop
End Select
End Sub
Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
Chemin = OpenFileDialog1.FileName
Importation()
End Sub
Private Sub FImport_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Label1.Text = "En attente d'intégration ..."
Interfaces()
End Sub
Sub Interfaces()
Dim a As Integer = Me.Width
Dim b As Integer = Label1.Width
Dim c As Integer = (a - b) / 2
Label1.Left = c
End Sub
End Class |
