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
|
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub DateTimePicker1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DateTimePicker1.ValueChanged
End Sub
Private Sub DateTimePicker2_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DateTimePicker2.ValueChanged
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Microsoft.Office.Interop.Excel.Workbook 'Classeur Excel
Dim wsExcel As Microsoft.Office.Interop.Excel.Worksheet 'Feuille Excel
appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Add()
wbExcel = appExcel.ActiveWorkbook
wsExcel = wbExcel.ActiveSheet
Dim monprocess As New Process
Dim nomfic As String = "C:\VB project\Seb\Seb.txt"
Dim Nombre_de_A As Integer = 0
Dim Nombre_de_M As Integer = 0
Dim x As Integer = 0
Dim a As String = "A"
Dim M As String = "M"
Dim zz As String
Dim zones() As String
Dim ligne_excel As Integer = 0
Label_nombre_de_A.Text = " "
Dim Date_debA As String = DateTimePicker1.Value.ToString("yyyyMMdd") ' Attention y et d en minuscule mais M en MAJUSCULE
Dim Date_finA As String = DateTimePicker2.Value.ToString("yyyyMMdd") ' Pour obtenir une chaine aaaaammjj
Dim Date_debM As String = DateTimePicker3.Value.ToString("yyyyMMdd") ' Attention y et d en minuscule mais M en MAJUSCULE
Dim Date_finM As String = DateTimePicker4.Value.ToString("yyyyMMdd") ' Pour obtenir une chaine aaaaammjj
'MsgBox(Date_deb & " " & Date_fin)
monprocess.StartInfo.FileName = "c:\VB Project\seb\Seb.bat"
monprocess.StartInfo.Arguments = ""
monprocess.StartInfo.WorkingDirectory = "c:\VB Project\seb"
monprocess.Start()
monprocess.WaitForExit()
MsgBox("Le programme de création du fichier de travail est terminé")
Try
FileOpen(1, nomfic, OpenMode.Input)
Do Until EOF(1) ' Jusqu'à la fin du fichier
zones = Split(LineInput(1), "/") 'Découpe suivant les "/"
zz = zones(2).Substring(0, 1) 'Attention Split ajoute un blanc à la fin de la chaine !!!
ctibon(x, zz, a, Date_debA, Date_finA, zones(1).Substring(0, 8), Nombre_de_A)
ctibon(x, zz, M, Date_debM, Date_finM, zones(1).Substring(0, 8), Nombre_de_M)
'x = String.Compare(zz, a, False) 'Comparaison sans tenir compte Majuscules / minuscules (argument false)
'If x = 0 Then ' Le code est A
' Nombre_de_A = Nombre_de_A + 1
' zz = zones(1).Substring(0, 8) ' La date de la ligne courante
' If zz >= Date_debA And zz <= Date_finA Then ' La date de la ligne est comprise entre les deux dates !
' 'MsgBox(zones(0) & " " & zones(1) & "Ligne à traiter")
' ligne_excel = ligne_excel + 1
' wsExcel.Cells(ligne_excel, 1) = zones(0).ToString
' wsExcel.Cells(ligne_excel, 2) = zones(1).ToString
' wsExcel.Cells(ligne_excel, 3) = zones(2).ToString
' End If
' End If
Loop
Catch ex As Exception
MsgBox("Fichier absent ou en erreur : " & ex.ToString)
Finally
FileClose(1)
'wsExcel.SaveAs("c:\VB project\Seb\seb.xls")
'appExcel.Quit()
TextBoxA.Text = Nombre_de_A.ToString
TextBoxM.Text = Nombre_de_M.ToString
End Try
End Sub
Private Sub ctibon(ByRef x As Integer, ByVal zat As String, ByVal code As String, ByVal dd As String, ByVal df As String, ByVal zd As String, ByRef nombre As Integer)
x = String.Compare(zat, code, False)
If x = 0 Then
If zd >= dd And zd <= df Then
nombre = nombre + 1
End If
End If
End Sub
End Class |
Programme à developper sous visual basic 2005
Répondre avec citation
Partager