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
| *** Public Function CreerMatriceCalibr(ByVal familleMot As String,
************************************** ByVal Calculateurs As List(Of String),
************************************** ByVal Emplacement As String,
************************************** ByVal Fichier As String,
************************************** ByVal majSoft As DataTable,
************************************** ByVal lstMoyens As Specialized.StringCollection,
************************************** ByVal Softs As Table_Softs,
************************************** ByVal anom As Table_Anomalie,
************************************** ByVal def As Table_Defaut,
************************************** ByVal roul As Table_Roulages,
************************************** ByVal ToutesLesAno As Boolean,
************************************** ByVal TousLesEtats As Boolean,
************************************** Optional ByVal visible As Boolean = False) As String******** MessageBox.Show("Veuillez attendre le message de fin de traitement avant d'utiliser Excel", "TRAITEMENT EN COURS", MessageBoxButtons.OK, MessageBoxIcon.Warning)******** 'Ouvre un fichier Excel
******* Dim objExcel As New Excel.Application
******* Dim objworkb As Excel.Workbook = OuvreUnFichierExcel(objExcel, My.Settings.Chemin_Manag_Eobd & My.Resources.Emplacement_Reporting & My.Resources.Emplacement_ModeleMatrice)******** Dim ObjsheetRef, ObjSheet As Excel.Worksheet
******* ObjsheetRef = objworkb.Worksheets("Modele")
******* Dim Feuil As Integer = ObjsheetRef.Index******** 'Cree une feuille par calculateur coché
******* Dim cptPage As Integer = 1
******* For Each Calculateur In Calculateurs
*********** 'Copie de la page modèle
*********** ObjsheetRef.Copy(After:=ObjsheetRef)************
ObjSheet = objworkb.Worksheets(Feuil + 1)
*********** Console.WriteLine(ObjSheet.Name)************
ObjSheet.Name = Calculateur & " (Page " & cptPage & ")" '"===<Erreur: ce nom existe deja"
*********** ObjSheet.Cells.Clear()************ 'Recherche toutes les majsoft liées aux calculateurs sélectionnés
*********** Dim listmajsofts As EnumerableRowCollection(Of DataRow) = From lMAJ In majSoft
********************************************************************* Where lMAJ.Item("Calculateur").ToString() = Calculateur
********************************************************************* Order By lMAJ.Item("Calculateur") Descending
********************************************************************* Select lMAJ************ GenererMatrice_Donnees(familleMot, Calculateur, ObjSheet, listmajsofts, lstMoyens, Softs, anom, def, roul, ToutesLesAno, TousLesEtats)
*********** cptPage += 1
******* Next Calculateur******** Dim i As Integer = 1******** Do
*********** Dim objWS As Excel.Worksheet
*********** objWS = objworkb.Worksheets(i)
*********** If (objWS.Name.ToString().Contains(" ")) Then
*************** objWS.Name = objWS.Name.Remove(objWS.Name.IndexOf(" "), objWS.Name.Length - objWS.Name.IndexOf(" "))
*********** End If************ If (objWS.Name.Contains("Modele")) Then
*************** objWS.Delete()
*********** Else
*************** i += 1
*********** End If******** Loop While i <= objworkb.Worksheets.Count******** If (Not Fichier = "") Then************ If (Not My.Computer.FileSystem.DirectoryExists(Emplacement & familleMot)) Then
*************** My.Computer.FileSystem.CreateDirectory(Emplacement & familleMot)
*********** End If************ If (My.Computer.FileSystem.DirectoryExists(Emplacement & familleMot)) Then**************** objworkb.SaveAs(Emplacement & familleMot & "\" & Fichier)
*************** objworkb.Close()
*************** objExcel.Quit()**************** 'Mise à jour fichier Texte Suivi Scoring des matrices
*************** AjoutLigneTxt("Creation" & ";" & familleMot & ";" & Fichier & ";" & Date.Now.ToShortDateString(),
************************** My.Settings.Chemin_Manag_Eobd & My.Resources.Emplacement_Reporting & My.Resources.Emplacement_SuiviMatrices)**************** MessageBox.Show("La matrice des défauts liés à la calibration a été générée sur le serveur Manag'EOBD", "MATRICE CALIBRATION", MessageBoxButtons.OK, MessageBoxIcon.Information)************ End If************ 'ForceExcelToQuit(objExcel)
*********** 'KillExcel()
*********** objExcel.Quit()************ Return Emplacement & familleMot & "\" & Fichier******** Else************ objworkb.SaveAs(Emplacement)
*********** MessageBox.Show("Extraction terminée. Fichier Excel disponible", "TRAITEMENT EN COURS", MessageBoxButtons.OK, MessageBoxIcon.Warning)************ 'objworkb.Close()
*********** 'objExcel.Quit()
*********** Return Nothing
******* End If*
*** End Function |
