[VBA]Stocker le nom d'une variable dans une autre variable

Version imprimable

bonjour,

je vous livre une partie de mon code :

Code:

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
For i = 1 To RS1L Step 1

ty = RS1.Fields("TYPE").Value
st = RS1.Fields("SOUS TYPE").Value
arg = RS1.Fields("REF").Value
    If arg = "NB" Then
    Else
        If ty = "PP" Then
            If st = "TR" Then
            x = 3
            Else
            x = 2
            End If
        ElseIf ty = "TR" Then
        x = 3
        ElseIf ty = "AF" Then
        x = 4
        End If
        For J = 1 To 8 Step 1
            If para(J, x) <> "" Then
            rec = para(J, x) & arg
                For k = 1 To 12 Step 1
                var = para(J, 1) & "(" & k & ")"
                champ = "champ" & k + 2
                set #var = RS1.Fields(champ).Value
                
                Next k
            Else
            End If
        Next J
    End If
RS1.MoveNext
Next i

Mon probleme est que je veut affecter a la variable dont le nom est contenu dans la variable "var" (type string) une valeur .

est ce que quelqu'un ici sait comment faire ?

merci

Franck

Bonsoir,

le mieux que ja sache faire est un Select Case:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim Variable1, Variable2, Variable3
Dim var As String
 
var = "<nom de la variable>"
 
Select Case var
   Case "Variable1"
       Variable1 = RS1.Fields(champ).Value
   Case "Variable2"
       Variable2 = RS1.Fields(champ).Value
   Case "Variable3"
       Variable3 = RS1.Fields(champ).Value
  .... etc ....
End Select

A+

20/04/2007, 19h23
strike57

j'ai bien peur que cette solution ne soit pas applicable dans mon cas, comme tu a pu le voir mon probleme se trouve en plein centre de 3 boucle, ce qui me fait en gros 96 variables differentes a envisager. sans compter que le probleme peut encore s'agraver par la suite.

une autre idée ??

Bonjour,

Citation:

Envoyé par strike57

j'ai bien peur que cette solution ne soit pas applicable dans mon cas, comme tu a pu le voir mon probleme se trouve en plein centre de 3 boucle, ce qui me fait en gros 96 variables differentes a envisager. sans compter que le probleme peut encore s'agraver par la suite.

C'est typiquement un cas d'usage pour un tableau.

Je me suis permis une petite adaptation personnelle de ton code où le tableau para prend une troisième dimension destinée à recevoir les valeurs des champs.

Comme je ne sais pas trop si tu veux pouvoir "bloquer" ou non la recopie des champs, je me suis dit qu'on pouvait faire commencer cette troisième dimension au rang zéro.

Code:

Dim para(1 To 8, 1 To 4, 0 To 12) As Variant

La position 0 permettrait ainsi de stocker "un éventuel quelque chose" à contrôler...
Code:

1 2 var = para(j, x, 0) If var <> "" Then
Mais tout ça, c'est sous réserve que j'ai bien compris ton code.
Voilà ma proposition:
Code:

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 Dim para(1 To 8, 1 To 4, 0 To 12) As Variant Dim var As Variant Dim i As Long, j As Integer, k As Integer, x As Integer Dim ty As String, st As String, arg As String Dim champ As String, rec As String Dim RS1L As Long Dim RS1 As DAO.Recordset 'DAO ou ADODB ? For i = 1 To RS1L ty = RS1.Fields("TYPE").Value st = RS1.Fields("SOUS TYPE").Value arg = RS1.Fields("REF").Value If arg <> "NB" Then 'nop Else Select Case ty Case "PP": x = IIf(st = "TR", 3, 2) Case "TR": x = 3 Case "AF": x = 4 End Select For j = 1 To 8 var = para(j, x, 0) If var <> "" Then rec = var & arg For k = 1 To 12 champ = "champ" & k + 2 para(j, x, k) = RS1.Fields(champ).Value Next k End If Next j End If RS1.MoveNext Next i

Une autre idée, qui finalement rejoint celle de =JBO=
utiliser une Collection

Exemple :
1. on définit une classe clUneVar (Nouveau module de classe sauvé sous clUneVar) dont voici le code

Code:

Public Value As Variant

2. on utilise une collection que l'on remplit avec des objets clUneVar et que l'on utilise par la suite en accédant à ses éléments par leur nom (Clé).
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Dim MesVars As New Collection, uneVar As clUneVar Dim i As Integer, var As String ' Initialisation de la collection ' La clé pour accéder à un élément est "ELTnn" où 0<nn<51 For i = 1 To 50 Set uneVar = New clUneVar MesVars.Add uneVar, "ELT" & CStr(i) Next ' On remplit des ELTnn au hazard Randomize For i = 1 To 50 var = "ELT" & CStr(1 + Int(49 * Rnd())) MesVars(var).Value = i Next ' On affiche toute la collection For i = 1 To 50 Debug.Print Str(i) & " : " & MesVars("ELT" & CStr(i)).Value Next Set MesVars = Nothing

Bon ben en finale j'ai reglé le Pb differement.

Je vous livre mon code au complet :

Je sait qu'il y en as qui vont dire que cela tiend plus du bricolage que de la programation, mais ca marche !! :mrgreen:

Code:

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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
Public Sub BUDGET()
 
'variables RECORDSET
Dim RS1 As DAO.Recordset
Dim RS1L As Integer
Dim RS2 As DAO.Recordset
Dim RS2L As Integer
Dim RS3 As DAO.Recordset
Dim RS3L As Integer
 
'variables programe
Dim ty As String
Dim st As String
Dim x As Integer
Dim arg As String
Dim rec As String
Dim var As String
Dim champ As String
Dim trouve As String
Dim KM As Double
Dim Deb As Date
Dim fini As Date
 
'variable de transduction
Dim para(1 To 8, 1 To 5) As Variant
 
para(8, 1) = "PV"
para(8, 2) = "PV"
para(8, 3) = ""
para(8, 4) = ""
para(8, 5) = ""
 
para(2, 1) = "CA"
para(2, 2) = "CAB"
para(2, 3) = "CAB"
para(2, 4) = "CAB"
para(2, 5) = "CAB"
 
para(3, 1) = "TRT"
para(3, 2) = "EFPPM"
para(3, 3) = "EFTR"
para(3, 4) = ""
para(3, 5) = ""
 
para(4, 1) = "KM"
para(4, 2) = "KMS"
para(4, 3) = "KMSTR"
para(4, 4) = ""
para(4, 5) = ""
 
para(7, 1) = "VIDE"
para(7, 2) = "TKV"
para(7, 3) = ""
para(7, 4) = ""
para(7, 5) = ""
 
para(6, 1) = "MARGE"
para(6, 2) = ""
para(6, 3) = ""
para(6, 4) = "MNET"
para(6, 5) = "MNET.AO"
 
para(5, 1) = "CAT"
para(5, 2) = ""
para(5, 3) = ""
para(5, 4) = ""
para(5, 5) = "CAB"
 
para(1, 1) = "CAN"
para(1, 2) = "CAN"
para(1, 3) = "CANS"
para(1, 4) = "CANS"
para(1, 5) = "CANT"
 
'Definition des recordset
Set RS1 = Application.CurrentDb.OpenRecordset("SERVICE", dbOpenTable, dbReadOnly)
RS1L = RS1.RecordCount
Set RS2 = Application.CurrentDb.OpenRecordset("BUDGET", dbOpenTable)
RS2L = RS2.RecordCount
Set RS3 = Application.CurrentDb.OpenRecordset("BUDGETTEMP", dbOpenTable)
RS3L = RS3.RecordCount
 
 
RS1.MoveFirst
 
For i = 1 To RS1L
 
    ty = RS1.Fields("TYPE").Value
    st = RS1.Fields("SOUS TYPE").Value
    arg = RS1.Fields("REF").Value
 
    If arg Like "NB" Then
        For J = 1 To 12
        RS2.AddNew
        RS2.Fields("MOIS").Value = J
        RS2.Fields("SERVICE").Value = RS1.Fields("SERVICE").Value
        Deb = IIf(J < 10, "01/0" & J & "/" & Year(Date), "01/" & J & "/" & Year(Date))
        fini = CDate(DateSerial(Year(Deb), Month(Deb) + 1, 0))
        RS2.Fields("NB").Value = ANAEX.Work_Days(Deb, fini, True)
        RS2.Update
        Next J
    Else
        Select Case ty
            Case "PP": x = IIf(st = "TR", 3, 2)
            Case "TR": x = 3
            Case "AF": x = 4
            Case "GL": x = 5
        End Select
 
        For J = 1 To 12
        RS2.AddNew
        RS2.Fields("MOIS").Value = J
        RS2.Fields("SERVICE").Value = RS1.Fields("SERVICE").Value
            For k = 1 To 8 Step 1
                If para(k, x) <> "" Then
                var = para(k, x) & arg
                rec = "champ" & (J + 2)
                trouve = "champ2 = '" & var & "'"
                RS3.Index = "champ2"
                RS3.MoveFirst
                RS3.Seek "=", var
                    Select Case k
                    Case 1
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 1000
                    Case 2
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 1000
                    Case 3
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value)
                    Case 4
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value)
                    Case 5
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 1000
                    Case 6
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 1000
                    Case 7
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) / 100
                    Case 8
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 100
                    End Select
                    Deb = IIf(J < 10, "01/0" & J & "/" & Year(Date), "01/" & J & "/" & Year(Date))
                    fini = CDate(DateSerial(Year(Deb), Month(Deb) + 1, 0))
                    RS2.Fields("NB").Value = ANAEX.Work_Days(Deb, fini, True)
                    Else
                    End If
                Next k
            RS2.Update
        Next J
    End If
 
    RS1.MoveNext
Next i
 
RS2.MoveFirst
    Do
        If RS2.Fields("SERVICE").Value = "*" Then
        i = RS2.Fields("MOIS").Value
 
        rec = "champ" & i + 2
        RS3.Index = "champ2"
        RS3.Seek "=", "KMS"
        KM = RS3.Fields(rec).Value
        RS3.Seek "=", "KMSTR"
        KM = KM + RS3.Fields(rec).Value
 
        RS2.Edit
        RS2.Fields("KM").Value = KM
        RS2.Update
        Else
        End If
    RS2.MoveNext
    Loop Until RS2.EOF
 
End Sub

Petite amélioration suggéree à ton code :

Code:

1
2
3
4
5
6
7
8
9
10
11
 
                    Select Case k
                    Case 1, 2, 5, 6
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 1000
                    Case 3, 4
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value)
                    Case 7
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) / 100
                    Case 8
                    RS2.Fields(para(k, 1)).Value = CDbl(RS3.Fields(rec).Value) * 100
                    End Select

dans 'case x,y,z', la virgule est comme un 'or'.

A+