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
|
Private Sub pXLMerger(ByVal strInputDir As String, ByVal stroutputDir As String)
'variables "classiques"
Dim iMaxSheet, iCountSheet, iCountRangeLines, iMinSheet, iCountRangeCol, iFirstLine As Integer
Dim bFirstFile As Boolean
Dim strLastRangeCol As String
'variables "fichier"
Dim fiFile As IO.FileInfo
Dim swTxt(4) As StreamWriter
'variables "Excel"
Dim appXL As New Excel.Application
Dim xlsInputWorkBook As Excel.Workbook
Dim xlsInputWorkSheet As Excel.Worksheet
'Diag
Dim swFichier As New Stopwatch
Dim ts As TimeSpan
Dim strElapsedTime As String
'afin de supprimer les entete de colonnes sur les fichiers suivant le premier,
'un booléen flag le premier fichier
bFirstFile = True
'initialisation des variables
strLastRangeCol = ""
iCountRangeLines = 0
iMinSheet = 10
'lancement d'Excel en background
appXL.Visible = False
appXL.DisplayAlerts = False
For i = 1 To 4
Dim fOutputFile As New FileInfo(stroutputDir & "_" & i.ToString & ".txt")
'suppression des fichiers existants
If fOutputFile.Exists Then fOutputFile.Delete()
'instanciation des flux d'ecritures
swTxt(i) = New StreamWriter(stroutputDir & "_" & i.ToString & ".txt", False)
Next
'info sur le répertoire contenant les fichiers
Dim fExploitFolderExistance As New IO.DirectoryInfo(strInputDir)
'liste des fichiers excel à 'merger'
Dim afiFileList As IO.FileInfo() = fExploitFolderExistance.GetFiles("*.xls")
Console.WriteLine("Debut du traitement des fichiers Excel")
swFichier.Start()
'boucle de copie des données
For Each fiFile In afiFileList
'ouverture du fichier xls
xlsInputWorkBook = appXL.Workbooks.Open(fiFile.FullName)
Console.WriteLine("fichier en cours : " & fiFile.Name)
'compte le nombre d'onglet du fichier
iMaxSheet = xlsInputWorkBook.Sheets().Count
'boucle par feuille
For iCountSheet = 1 To iMaxSheet
'selection de la feuille à traiter
xlsInputWorkSheet = xlsInputWorkBook.Worksheets(iCountSheet)
'je n'ai pas besoin de copier le contenus des feuilles cachées (d'ailleurs le programme plante si j'essai de copier leur contenus)
If xlsInputWorkSheet.Visible = Excel.XlSheetVisibility.xlSheetVisible Then
If iMinSheet > iCountSheet Then iMinSheet = iCountSheet
'activation de la feuille
xlsInputWorkSheet.Activate()
'copie et ajout d'un nouveau range à la collection de range
Dim xlsInputUsedRange As Excel.Range = xlsInputWorkSheet.UsedRange
iCountRangeCol = xlsInputUsedRange.Columns.Count
iCountRangeLines = xlsInputUsedRange.Rows.Count
strLastRangeCol = GetColumn(iCountRangeCol)
If bFirstFile = True Then
iFirstLine = 1
Else
iFirstLine = 2
End If
xlsInputWorkSheet.Range("A" & iFirstLine.ToString, strLastRangeCol & iCountRangeLines.ToString).Copy()
swTxt(iCountSheet).WriteLine(Clipboard.GetText())
Clipboard.Clear()
End If
Next iCountSheet
'si c'est le premier fichier qui vient d'etre traiter on change le flag
If bFirstFile = True Then bFirstFile = False
Clipboard.Clear()
xlsInputWorkBook.Close(False)
releaseObject(xlsInputWorkBook)
Next
'une fois tous les fichiers traiter on fermer les flux d'ecriture un par un
'For Each swTxt In swTxtCollection
For i = iMinSheet To iCountSheet - 1
swTxt(i).Close()
Next
swFichier.Stop()
ts = swFichier.Elapsed
swFichier.Reset()
strElapsedTime = String.Format("{0:00}:{1:00}.{2:000}", ts.Minutes, ts.Seconds, ts.Milliseconds)
Console.WriteLine("Fin du traitement, durée : " & strElapsedTime)
releaseObject(swTxt)
'puis on ferme excel (ici ca ne semble pas marché car bien qu'aucune erreur ne remonte,
'excel.exe reste lister dans le gestionnaire des taches, une idée peut-etre?)
appXL.Quit()
releaseObject(appXL)
GC.Collect()
End Sub
'une simple fonction qui revoie une lettre (ou une suite de lettre) quand on lui fournis un chiffre
Function GetColumn(ByVal aValue As Long) As String
If aValue Mod 26 = 0 Then
If aValue = 26 Or aValue = 0 Then
GetColumn = "Z"
Else
GetColumn = Chr(64 + (aValue \ 26 - 1)) & GetColumn(aValue Mod 26)
End If
Else
If aValue < 26 Then
GetColumn = Chr(64 + aValue)
Else
GetColumn = Chr(64 + (aValue \ 26)) & GetColumn(aValue Mod 26)
End If
End If
End Function
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub |
Optimisation de code vb.net Excel vers txt
Répondre avec citation
Envoyé par sperot51
Partager