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
|
strCmd = "SELECT * FROM PARAM_CHEMIN WHERE NOM_FICHIER = 'Export_Matrice'"
If (ExecSQL(strCmd, rst)) Then
'strCheminS = rst.Fields("CHEMIN_FICHIER") & "Jour\Recu\Source\Entité\Recu_Source_Jour_Entité.xls"
'MsgBox strCheminS
strCheminD = rst.Fields("CHEMIN_FICHIER") & "Jour\Recu\Source\Entité\Recu_Source_Jour_Entité_" & Format(txtDate.Caption, "DDMMYYYY") & ".xls"
'If (objFSO.FileExists(strCheminS)) Then
strCmd = "SELECT LIBELLE_PRESTATION, SUM(NB_RECU) AS NB_RECU1, DATE_RECU, LIBELLE_ENTITE, NOM_FLUX " & _
"FROM FLUX, PRESTATION, ENTITE, RECU " & _
"WHERE FLUX.ID_FLUX = PRESTATION.ID_FLUX AND PRESTATION.ID_PRESTATION = RECU.ID_PRESTATION AND RECU.ID_ENTITE = ENTITE.ID_ENTITE " & _
"AND DATE_RECU = #" & CDate(Format(CDate(txtDate.Caption), "MM/DD/YYYY")) & "# AND LIBELLE_ENTITE = '" & txtSelect.Caption & "'" & _
"GROUP BY NOM_FLUX, LIBELLE_ENTITE, LIBELLE_PRESTATION, DATE_RECU"
If (ExecSQL(strCmd, rst)) Then
If (Not rst.EOF) Then
Set objWbk = objExcel.Workbooks.Add
Set objSheet = objWbk.Sheets("Feuil1")
'objSheet.Activate
objSheet.Cells(2, 2) = "Reçu du " & Format(rst.Fields("DATE_RECU").Value, "DD/MM/YYYY") & " pour : " & rst.Fields("LIBELLE_ENTITE").Value
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Merge
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Font.Bold = True
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.Color = RGB(0, 0, 0)
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).HorizontalAlignment = xlHAlignCenter
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).VerticalAlignment = xlVAlignCenter
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.Weight = xlMedium
objSheet.Range(objSheet.Cells(2, 2), objSheet.Cells(4, 6)).Borders.LineStyle = xlContinuous
objSheet.Cells(6, 1) = "Source"
objSheet.Cells(6, 1).Font.Bold = True
objSheet.Cells(6, 1).HorizontalAlignment = xlHAlignCenter
objSheet.Cells(6, 1).Borders.Color = RGB(0, 0, 0)
objSheet.Cells(6, 1).Borders.Weight = xlMedium
objSheet.Cells(6, 1).Borders.LineStyle = xlContinuous
objSheet.Cells(6, 2) = "Libellé Typologie"
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Merge
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Font.Bold = True
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).HorizontalAlignment = xlHAlignCenter
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.Color = RGB(0, 0, 0)
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.Weight = xlMedium
objSheet.Range(objSheet.Cells(6, 2), objSheet.Cells(6, 5)).Borders.LineStyle = xlContinuous
objSheet.Cells(6, 6) = "Nombre"
objSheet.Cells(6, 6).Font.Bold = True
objSheet.Cells(6, 6).HorizontalAlignment = xlHAlignCenter
objSheet.Cells(6, 6).Borders.Color = RGB(0, 0, 0)
objSheet.Cells(6, 6).Borders.Weight = xlMedium
objSheet.Cells(6, 6).Borders.LineStyle = xlContinuous
i = 1
j = 1
While Not rst.EOF
objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value
objSheet.Cells(6 + i, 2) = rst.Fields("LIBELLE_PRESTATION").Value
objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Merge
objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).HorizontalAlignment = xlHAlignCenter
objSheet.Range(objSheet.Cells(6 + i, 2), objSheet.Cells(6 + i, 5)).Borders.Color = RGB(0, 0, 0)
objSheet.Cells(6 + i, 6) = rst.Fields("NB_RECU1").Value
objSheet.Cells(6 + i, 6).Borders.Color = RGB(0, 0, 0)
rst.MoveNext
If (Not rst.EOF) Then
If (objSheet.Cells(6 + i, 1) = rst.Fields("NOM_FLUX").Value) Then
objSheet.Cells(6 + i, 1) = ""
j = j + 1
Else
k = i + j
End If
Else
k = i + j
End If
i = i + 1 Wend
MsgBox "Merge(" & j & ", " & k & ")"
objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).Merge
objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).HorizontalAlignment = xlHAlignCenter
objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).Borders.Color = RGB(0, 0, 0)
objSheet.Range(objSheet.Cells(j, 1), objSheet.Cells(k, 1)).VerticalAlignment = xlVAlignCenter
Set objSheet = Nothing
objWbk.Close True, strCheminD
Set objWbk = Nothing
MsgBox "Votre fichier à été sauvegardé à l'emplacement suivant : " & vbCrLf & strCheminD
Else
MsgBox "Aucune donnée à exporter ! "
End If
End If
End If |
