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
|
Public Sub ExportExcel(flexgrid As MSFlexGrid, ParamTemps As String)
Dim exc As Excel.Application 'Application Excel
Set exc = New Excel.Application
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
Dim NombreDeLigne As Integer
Dim NombreDeColonne As Integer
Dim i As Integer
Dim j As Integer
Dim colonne As String
Dim Form As Form
Dim Destination As String
On Error GoTo TRAITEMENT_ERREUR
'Ouverture de l'application
Set appexcel = CreateObject("Excel.Application")
'Ouverture d'un fichier Excel
Set wbExcel = appexcel.Workbooks.Open(App.Path + "\sample.xls")
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)
'255 colonnes Excel
colHeader = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
"AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", _
"BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", _
"CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", _
"DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY", "DZ", _
"EA", "EB", "EC", "ED", "EE", "EF", "EG", "EH", "EI", "EJ", "EK", "EL", "EM", "EN", "EO", "EP", "EQ", "ER", "ES", "ET", "EU", "EV", "EW", "EX", "EY", "EZ", _
"FA", "FB", "FC", "FD", "FE", "FF", "FG", "FH", "FI", "FJ", "FK", "FL", "FM", "FN", "FO", "FP", "FQ", "FR", "FS", "FT", "FU", "FV", "FW", "FX", "FY", "FZ", _
"GA", "GB", "GC", "GD", "GE", "GF", "GG", "GH", "GI", "GJ", "GK", "GL", "GM", "GN", "GO", "GP", "GQ", "GR", "GS", "GT", "GU", "GV", "GW", "GX", "GY", "GZ", _
"HA", "HB", "HC", "HD", "HE", "HF", "HG", "HH", "HI", "HJ", "HK", "HL", "HM", "HN", "HO", "HP", "HQ", "HR", "HS", "HT", "HU", "HV", "HW", "HX", "HY", "HZ", _
"IA", "IB", "IC", "ID", "IE", "IF", "IG", "IH", "II", "IJ", "IK", "IL", "IM", "IN", "IO", "IP", "IQ", "IR", "IS", "IT", "IU", "IV")
Select Case ParamTemps
Case "Heure"
NombreDeColonne = 48 '2 jours
If G_FormExport = "Concentrations" Then
Set Form = F_Concentrations
Else
Set Form = F_MesuresPhysiques
End If
Case "Jour"
NombreDeColonne = 40 '40 jours
If G_FormExport = "Concentrations" Then
Set Form = F_ConcentrationsJour
Else
Set Form = F_MesuresPhysiquesJour
End If
Case "Mois"
NombreDeColonne = 120 '10 ans
If G_FormExport = "Concentrations" Then
Set Form = F_ConcentrationsMois
Else
Set Form = F_MesuresPhysiquesMois
End If
Case "Annee"
NombreDeColonne = 15 '15 ans
If G_FormExport = "Concentrations" Then
Set Form = F_ConcentrationsAnnuelles
Else
Set Form = F_MesuresPhysiquesAnnuelles
End If
End Select
NombreDeLigne = flexgrid.Rows
'On recopie les libelles des variables, les unites, et le titre du tableau
For j = 1 To 2
For i = 1 To NombreDeLigne
If j = 1 Then
If i = 1 Then
colonne = colHeader(j - 1) + CStr(i)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = Form.La_titre.Caption
Else
colonne = colHeader(j - 1) + CStr(i + 1)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = Form.LA_Var(i - 2).Caption
End If
Else
If i <> 1 Then
colonne = colHeader(j - 1) + CStr(i + 1)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = Form.LA_Unite(i - 2).Caption
End If
End If
Next i
Next j
'on recopie le contenu du tableau
For j = 3 To NombreDeColonne
For i = 2 To NombreDeLigne + 1 'On Commence à écrire à la troisiéme ligne
If i = 2 Then
colonne = colHeader(j - 1) + CStr(1)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = Format(Mid(flexgrid.TextMatrix(i - 2, j - 2), 1, 10), "MM/DD/YYYY")
colonne = colHeader(j - 1) + CStr(2)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = Mid(flexgrid.TextMatrix(i - 2, j - 2), 12, 8)
Else
colonne = colHeader(j - 1) + CStr(i)
Range(colonne, colonne).Select
ActiveCell.FormulaR1C1 = flexgrid.TextMatrix(i - 2, j - 2)
End If
Next i
Next j
Call MsgBox("Export vers Excel réalisé avec succés", vbInformation, "Export")
Destination = App.Path + "\XLS Files\Extract" + ParamTemps + CStr(Replace(Replace(Now, "/", ""), ":", "")) + ".xls"
Range("A1").Select
ActiveWorkbook.SaveAs FileName:=Destination, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
exc.Quit
wbExcel.Close
Set exc = Nothing
Set appexcel = Nothing
Set wbExcel = Nothing
Set wsExcel = Nothing
Exit Sub
TRAITEMENT_ERREUR:
Call enre_defaut("Erreur SUB (M_Excel -> ExportExcel) :" + Error(Err))
exc.Quit
wbExcel.Close
Set exc = Nothing
Set appexcel = Nothing
Set wbExcel = Nothing
Set wsExcel = Nothing
End Sub |
Partager