Problème algorithme pour TCD

**OZ1977** · 12/04/2018, 20h02

Bonjour,

je souhaite coder un tableau croisé dynamique (TCD) dans un fichier excel depuis access
mais j'ai un problème d’algorithmie

j'ai une Requête3 qui produit un tableau (cf onglet Feuil2 dans le fichier excel joint)
je souhaite présenter ce tableau sous la forme d'un TCD sans utiliser le TCD excel (oui je sais c'est tordu mais j'ai pas le choix) pour obtenir le résultat de l'onglet Feuil1
mais j'obtiens le résultat de l'onglet 3

je bugg sur les indices pour ma mise en forme et j'y ai passé la journée !!!
d'avance merci pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub EXPORT()
 
'Dim appexcel As Excel.Application
'Dim wbexcel As Excel.Workbook
Dim rs1, rs2 As DAO.Recordset
 
Dim fso As Object, Src$, Dest$, Fich1$, Fich2$
 
'récupération de la date du merger
'Dat_merger = Format(dat_point, "yyyymmdd")
Date_report = Format(Now(), "yyyymmdd")
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
Src = "D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\"
Dest = "D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\"
Fich1$ = "Report.xlsm"
Fich2$ = "Report_" & Date_report & ".xlsm"
fso.CopyFile Src & Fich1, Dest & Fich2
 
 
Set appexcel = CreateObject("Excel.Application")
appexcel.Visible = False
Set wbexcel = appexcel.Workbooks.Open("D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\" & Fich2 & "")
 
'en-tête du tableau
appexcel.Sheets("Feuil1").Select
 
appexcel.Cells(1, 1) = "Funder"
appexcel.Cells(2, 1) = "Organisation name"
 
appexcel.Cells(4, 1) = "Output"
appexcel.Cells(4, 2) = "Expense Group"
appexcel.Cells(4, 3) = "Expense Description"
appexcel.Cells(4, 4) = "Travel / staff description"
appexcel.Cells(4, 5) = "2017 (USD)"
appexcel.Cells(4, 6) = "Budget 2017 (local currency)"
appexcel.Cells(4, 7) = "Actuals 2017 (USD)"
appexcel.Cells(4, 8) = "Actuals 2017 (local currency)"
appexcel.Cells(4, 9) = "Staff : Salary (all taxes)"
appexcel.Cells(4, 10) = "Staff: men/month"
appexcel.Cells(4, 11) = "Variances (USD)"
appexcel.Cells(4, 12) = "Variance adjusted (USD)"
appexcel.Cells(4, 13) = "Variance local currency"
appexcel.Cells(4, 14) = "%"
appexcel.Cells(4, 15) = "Justification"
appexcel.Cells(4, 16) = "Ref.Receipt"
 
Set rs1 = CurrentDb.OpenRecordset("Select * from Requête3")
If Not rs1.EOF Then rs1.MoveFirst
 
i = 0
x = 5
y = 1
Output = ""
Group = ""
 
Do While Not rs1.EOF
 
appexcel.Sheets("Feuil1").Select
If Output = rs1.Fields(0).Value And Group = rs1.Fields(1).Value And Description = rs1.Fields(2).Value Then
    'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
        If IsNull(rs1.Fields(3).Value) Then
            appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
        Else
            appexcel.Cells(x + 1, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 1, y + 4) = rs1.Fields(4).Value
        End If
i = 3
 
ElseIf Output = rs1.Fields(0).Value And Group = rs1.Fields(1).Value Then
    appexcel.Cells(x, y + 2) = rs1.Fields(2).Value
    'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
        If IsNull(rs1.Fields(3).Value) Then
            appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
        Else
            appexcel.Cells(x + 1, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 1, y + 4) = rs1.Fields(4).Value
        End If
i = 1
 
ElseIf Output = rs1.Fields(0).Value Then
    appexcel.Cells(x + 1, y + 1) = rs1.Fields(1).Value
    appexcel.Cells(x + 2, y + 2) = rs1.Fields(2).Value
    'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
        If IsNull(rs1.Fields(3).Value) Then
            appexcel.Cells(x + 2, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 2, y + 4) = rs1.Fields(4).Value
        Else
            appexcel.Cells(x + 3, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 3, y + 4) = rs1.Fields(4).Value
        End If
i = 3
 
Else
    appexcel.Cells(x, y) = rs1.Fields(0).Value
    appexcel.Cells(x + 1, y + 1) = rs1.Fields(1).Value
    appexcel.Cells(x + 2, y + 2) = rs1.Fields(2).Value
    'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
        If IsNull(rs1.Fields(3).Value) Then
            appexcel.Cells(x + 2, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 2, y + 4) = rs1.Fields(4).Value
        Else
            appexcel.Cells(x + 3, y + 3) = rs1.Fields(3).Value
            appexcel.Cells(x + 3, y + 4) = rs1.Fields(4).Value
        End If
i = 3
End If
 
Output = rs1.Fields(0).Value
Group = rs1.Fields(1).Value
Description = rs1.Fields(2).Value
Travel = rs1.Fields(3).Value
 
rs1.MoveNext
x = x + i
Loop
 
'repositionner le curseur sur le premier onglet avant enregistrement pour le classeur s'ouvre dessu
appexcel.Sheets("Feuil1").Select
appexcel.Cells(1, 1).Select
 
wbexcel.Close True 'en mettant true tu enregistres en fermant (false si tu ne veux pas le faire)
Set wbexcel = Nothing
Set appexcel = Nothing
 
 
End Sub

**Zekraoui_Jakani** · 13/04/2018, 12h19

Pour présenter le tableau sous forme d'un TCD sans utiliser le TCD excel, vous pouvez exploiter le TCD Access = requête analyse croisée dans le wizard des requêtes.

**EricDgn** · 13/04/2018, 12h54

Bonjour,
Ceci pourrait peut-être convenir:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
 
 
Sub EXPORT()
 
'Dim appexcel As Excel.Application
'Dim wbexcel As Excel.Workbook
Dim rs1, rs2 As DAO.Recordset
 
Dim fso As Object, Src$, Dest$, Fich1$, Fich2$
 
'récupération de la date du merger
'Dat_merger = Format(dat_point, "yyyymmdd")
Date_report = Format(Now(), "yyyymmdd")
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
Src = "D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\"
Dest = "D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\"
Fich1$ = "Report.xlsm"
Fich2$ = "Report_" & Date_report & ".xlsm"
fso.CopyFile Src & Fich1, Dest & Fich2
 
 
Set appexcel = CreateObject("Excel.Application")
appexcel.Visible = False
Set wbexcel = appexcel.Workbooks.Open("D:\Users\jl3\2_ETUDES\10_TB_Speed\Template financier\" & Fich2 & "")
 
'en-tête du tableau
appexcel.Sheets("Feuil1").Select
 
appexcel.Cells(1, 1) = "Funder"
appexcel.Cells(2, 1) = "Organisation name"
 
appexcel.Cells(4, 1) = "Output"
appexcel.Cells(4, 2) = "Expense Group"
appexcel.Cells(4, 3) = "Expense Description"
appexcel.Cells(4, 4) = "Travel / staff description"
appexcel.Cells(4, 5) = "2017 (USD)"
appexcel.Cells(4, 6) = "Budget 2017 (local currency)"
appexcel.Cells(4, 7) = "Actuals 2017 (USD)"
appexcel.Cells(4, 8) = "Actuals 2017 (local currency)"
appexcel.Cells(4, 9) = "Staff : Salary (all taxes)"
appexcel.Cells(4, 10) = "Staff: men/month"
appexcel.Cells(4, 11) = "Variances (USD)"
appexcel.Cells(4, 12) = "Variance adjusted (USD)"
appexcel.Cells(4, 13) = "Variance local currency"
appexcel.Cells(4, 14) = "%"
appexcel.Cells(4, 15) = "Justification"
appexcel.Cells(4, 16) = "Ref.Receipt"
 
Set rs1 = CurrentDb.OpenRecordset("Select * from Requête3")
If Not rs1.EOF Then rs1.MoveFirst
 
i = 0
x = 5
y = 1
Output = ""
Group = ""
appexcel.Sheets("Feuil1").Select
 
Do While Not rs1.EOF
 
   If Output = rs1.Fields(0).Value _
      And Group = rs1.Fields(1).Value _
      And Description = rs1.Fields(2).Value _
      Then
      'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
      If Not IsNull(rs1.Fields(3).Value) Or Not IsNull(rs1.Fields(3).Value) Then
         x = x + 1
         appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
         appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
      End If
 
   ElseIf Output = rs1.Fields(0).Value _
      And Group = rs1.Fields(1).Value _
      Then
      x = x + 1
      appexcel.Cells(x, y + 2) = rs1.Fields(2).Value
      'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
      If Not IsNull(rs1.Fields(3).Value) Or Not IsNull(rs1.Fields(4).Value) Then
         x = x + 1
         appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
         appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
      End If
 
   ElseIf Output = rs1.Fields(0).Value _
      Then
      x = x + 1
      appexcel.Cells(x, y + 1) = rs1.Fields(1).Value
      x = x + 1
      appexcel.Cells(x, y + 2) = rs1.Fields(2).Value
      'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
      If Not IsNull(rs1.Fields(3).Value) Or Not IsNull(rs1.Fields(4).Value) Then
         x = x + 1
         appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
         appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
      End If
 
   Else
      x = x + 1
      appexcel.Cells(x, y) = rs1.Fields(0).Value
      x = x + 1
      appexcel.Cells(x, y + 1) = rs1.Fields(1).Value
      x = x + 1
      appexcel.Cells(x, y + 2) = rs1.Fields(2).Value
      'Test sur le contenu de Travel / Staff : quand vide, on n'insère pas de ligne (évite d'avoir des lignes (vide) dans le TCD)
      If Not IsNull(rs1.Fields(3).Value) Or Not IsNull(rs1.Fields(4).Value) Then
         x = x + 1
         appexcel.Cells(x, y + 3) = rs1.Fields(3).Value
         appexcel.Cells(x, y + 4) = rs1.Fields(4).Value
      End If
   End If
 
   Output = rs1.Fields(0).Value
   Group = rs1.Fields(1).Value
   Description = rs1.Fields(2).Value
   Travel = rs1.Fields(3).Value
 
   rs1.MoveNext
Loop
 
'repositionner le curseur sur le premier onglet avant enregistrement pour le classeur s'ouvre dessu
appexcel.Sheets("Feuil1").Select
appexcel.Cells(1, 1).Select
 
wbexcel.Close True 'en mettant true tu enregistres en fermant (false si tu ne veux pas le faire)
Set wbexcel = Nothing
Set appexcel = Nothing
 
End Sub

Il faut tenir compte du fait que parfois il y a un montant sans "staff description", d'où les

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not IsNull(rs1.Fields(3).Value) Or Not IsNull(rs1.Fields(4).Value) Then

A noter que tous les .Value ne sont sans pas indispensable (.Value étant la propriété par défaut).

Bonne continuation.

**OZ1977** · 14/04/2018, 14h04

merci pour vos réponse
j'ai trouvé une autre alternative un peu "bidouille" mais çà le fait : je supprime les lignes vides une fois le TCD construit

Problème algorithme pour TCD

VBA Access

Discussions similaires

Partager

Partager