Probl sur boucle

**alexandrek** · 25/01/2011, 19h01

Bonjour

voila j'ai un gros soucis sur mon code

je voudrais a travers ce code que lorsque je clique sur une cellule de la colonne D (de la ligne 1 a 158) cette macro selectionne les données correspondantes de la colonne A à M et ensuite
que chaque cellule (ex a1, b1, c1 .... m1) soit renomée ....

mon programe beug terriblement
alala les débuts ds vba

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
 
 
Sub selectdata()
 
Dim i As Integer
Dim j As Integer
 
Dim seltrade As Variant
 
For Each seltrade In Worksheets("2401").Range("D27:D158")
 
For i = 1 To 158
    If Selection = Range("D,i") Then
    Range(ActiveCell, ActiveCell.Offset(0, -3)).Select
    Range(ActiveCell, ActiveCell.Offset(0, 12)).Select
    End If
 
Next i
 
For j = 1 To 13
 
 
ActiveWorkbook.Names.Add Name:="CLI1", RefersToR1C1:="=Feuil2401!R(i)C(J)"
ActiveWorkbook.Names.Add Name:="REC1", RefersToR1C1:="=Feuil2401!R(i)C(J+1)"
ActiveWorkbook.Names.Add Name:="PAY1", RefersToR1C1:="=Feuil2401!R(i)C(J+2)"
ActiveWorkbook.Names.Add Name:="DEALSL1", RefersToR1C1:="=Feuil2401!R(i)C(J+3)"
ActiveWorkbook.Names.Add Name:="SF1", RefersToR1C1:="=Feuil2401!R(i)C(J+4)"
ActiveWorkbook.Names.Add Name:="VALD1", RefersToR1C1:="=Feuil2401!R(i)C(J+5)"
ActiveWorkbook.Names.Add Name:="AMCCY111", RefersToR1C1:="=Feuil2401!R(i)C(J+6)"
ActiveWorkbook.Names.Add Name:="AMCCY221", RefersToR1C1:="=Feuil2401!R(i)C(J+7)"
ActiveWorkbook.Names.Add Name:="CCYON1", RefersToR1C1:="=Feuil2401!R(i)C(J+8)"
ActiveWorkbook.Names.Add Name:="CCYTT1", RefersToR1C1:="=Feuil2401!R(i)C(J+9)"
ActiveWorkbook.Names.Add Name:="RATES1", RefersToR1C1:="=Feuil2401!R(i)C(J+10)"
 
 
Next j
 
Next
End Sub

merci de votre compréhension

**MarcelG** · 25/01/2011, 19h35

Bonsoir Alexandrek,

Ouh là là !

Aucun problème, on va reprendre de bout en bout, ce soir et demain.

1 - Sache tout d'abord qu'en VBA, pour exercer une action, tu n'as pas besoin de sélectionner ton objet (Range)

Code :

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

1
2
Range("A1").Select
Selection.Value = 1

doit être remplacé par

Code :

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

Range("A1").Value = 1

Le code s'en trouve plus clair et plus performant.

2 - Dans ton code, si tu boucles avec une occurence i, celle-ci ne doit pas être incluse dans une chaîne de caractères (entre guillemets)

Code :

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

Range("D,i")

ne veut rien dire car l'occurence "i" est alors considérée "en dur"

Il faut remplacer par

Code :

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

Range("D"&i)

3 - Si j'ai bien compris, tu veux avoir autant de noms que de cellules de nombre = lignes * colonnes.

Joins un fichier simplifié en précisabnt quelles cellules tu veux nommer.

**alexandrek** · 25/01/2011, 19h48

voila le fichier je veux renomer en faite si i = 8 en cliquant sur d8

toutes les cellules a8 jusqu'a M8

toutes les cellules a traves cette boucle que je veux modifier sont en rouge

tres tres dur les debuts en vba

merci bcp en tout cas de votre aide

**MarcelG** · 25/01/2011, 19h53

Alexandrek,

J'ai adapté un code.

Pour cela, il te faut placer les racines "CLI" etc en entêtes de colonnes, donc en ligne, à partir de E26 puisque tu balaies à partir de la ligne 27.

Donc quelquechose comme

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
Sub CréatNoms()
 
Dim débnoms as range
Dim listnoms as range
 
Set débnoms = Sheets("2401").Range("E26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each nom In listnoms
    For i = 1 To 132
        ActiveWorkbook.Names.Add Name:=nom.Value &"_" & i, RefersToR1C1:=nom.Offset(i, 0)
    Next
Next
 
End Sub

Tes noms seront cr"és du type CLI_1, REC_1 ... en ligne 27, CLI_2, REC_2... en ligne 28 etc...

Tu obtiendrais ainsi 11 * 132 noms, ce qui est énorme.

Précise bien si cela correspond à ta recherche.

A demain.

**MarcelG** · 25/01/2011, 20h01

Alexandrek,

Nos posts se sont croisés.

Je ne crois pas qu'il existe un évènement click, mais plutôt doubleclick.

En tout cas, ton développement est intéressant.

On en reparle demain. Promis.

**alexandrek** · 25/01/2011, 20h03

IL ME MARQUE LA variable nom n est pas définie ?

**Qwazerty** · 25/01/2011, 20h09

Salut
http://www.developpez.net/forums/d10...ucle-for-next/
Évite d'ouvrir plusieurs postes sur le même sujet.
Des modifications de ton code t'ont été proposées, et tu n'en tiens pas compte dans le "nouveau" code que tu nous proposes, pourtant elle me paraissent très a propos.

Il serait bien de nous expliquer globalement (globalement, mais clairement quand même hein

) ce que tu souhaites faire, il serait alors plus facile pour les gens présents sur le forum de te conseiller dans la structure de ton code.

++
Qwaz

**MarcelG** · 25/01/2011, 20h49

Bonsoir Qwaz,
Alexander,

Ajoute après les 2 premières déclarations

Code :

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

Dim nom as Range

(tu dois être en Options Explicit, toutes tes variables doivent être déclarées,
Personnellement, je trouve que les codes y gagnent en clarté)

Pour le reste, je rejoins Qwaz. Précise bien où tu veux en venir.

A demain.

**alexandrek** · 25/01/2011, 22h03

En faite je vous explique tout

A travers un double click d'une cellule ds la colonne D d'une page selectionnée qui peut etre la page 2401 ou autre par exemple (dans mon code la dernière du classeur car j arrive pas à le faire marcher pr une page selectionnée ) , je veux faire remonter toutes les données de la ligne de la colone A à M .... correspondant au numero d 'un "deal" (contenu donc ds la colonne D)
ensuite renomer chaque cellule A1 par exemple à M1 (comme vous m avez indiqué auparavant, ce qui marche tres bien d'ailleurs )

ensuite il faut q je rassemble CLI_1 avec REC_1 avec PAY_1 .... jusqu'à RATE_1
pour envoyer chaque donner ds un ticket resumant mon deal

dans mon code j'ai un gros probl car qd je fais reference à une page selectionée il me renvoie trop d erreur tandis que qd je mets la derniere page du classeur ça marche

je vous joins tout mon code mais je bloque bcp qd meme faut avouer lol

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
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
 
Option Explicit ' pour obliger a declarer toutes tes variables
 
Public i As Integer
Public Nom As String
Public MaFeuille As Worksheet
Public message As String
Public MaNewFeuille As Worksheet
 
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
 
 
Set débnoms = Sheets(Sheets.Count).Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each débnoms In listnoms
    For i = 1 To 50
        ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
    Next
Next
 
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    For i = 1 To 50
        If Selection = Range("D" & i) Then
        Selection = Range("A" & i, ActiveCell.Offset(0, 12))
        End If
    Next i
 
 
End Sub
 
 
Sub Transf_Data()
'
' Transf_Data Macro
'
'
'   Création nouvelle page avec le numero du deal
 
Set MaFeuille = Sheets(Sheets.Count)
 
Nom = Sheets(Sheets.Count).Range("D27").Value
 
'On verifie que le nom n'existe pas déjà
On Error Resume Next 'en cas d'erreur, on continu sans generer d'erreur
Set MaNewFeuille = Sheets(Nom)
On Error GoTo 0 'on réactive la gestion d'erreur
'On verifie si la variable a obtenu un objet ou non
If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
 
 
'Sinon on continu
'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
'Renome la nouvelle feuille
MaNewFeuille.Name = Nom
 
 
 
'   Creation tab et mise en page
 
 
Sheets("REF").Select
Range("A1:E17").Select
    Selection.Copy
    Sheets(Nom).Select
    ActiveSheet.Paste
 
    Columns("B:B").ColumnWidth = 20.29
    Columns("C:C").ColumnWidth = 6.29
    Columns("D:D").ColumnWidth = 15.43
    Rows("3:3").Select
    Selection.RowHeight = 20.25
    Rows("4:4").Select
    Selection.RowHeight = 15.75
    Rows("5:5").Select
    Selection.RowHeight = 15.75
    Rows("6:6").Select
    Selection.RowHeight = 15.75
    Rows("7:7").Select
    Selection.RowHeight = 15.75
    Rows("8:8").Select
    Selection.RowHeight = 15.75
    Rows("9:9").Select
    Selection.RowHeight = 15.75
    Rows("10:10").Select
    Selection.RowHeight = 15.75
    Rows("11:11").Select
    Selection.RowHeight = 15.75
    Rows("12:12").Select
    Selection.RowHeight = 15.75
    Rows("13:13").Select
    Selection.RowHeight = 15.75
    Rows("14:14").Select
    Selection.RowHeight = 15.75
    Rows("15:15").Select
    Selection.RowHeight = 15.75
    Rows("16:16").Select
    Selection.RowHeight = 15.75
 
    Range("C4:D4").Select
    Selection.ClearContents
 
     Range("C6:D8").Select
    Selection.ClearContents
 
    Range("C10:D16").Select
    Selection.ClearContents
 
 
 
    Range("C13:D13").Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Selection.Font.Italic = False
    Selection.Font.Italic = True
 
 
 
 
'   Déclarer variables à copier
 
    Dim CLI As Range
 
    Dim REC As Range
 
    Dim PAY As Range
 
    Dim DS As Range
 
    Dim SF As Range
 
    Dim VD As Range
 
    Dim AMCCY1 As Range
 
    Dim AMCCY2 As Range
 
    Dim CCYO As Range
 
    Dim CCYT As Range
 
    Dim RATE As Range
 
 
 
'  Determine destination variables ds "deal" worksheet
 
 For i = 1 To 50
 
    Set CLI = CLI & "_" & i = Sheets(Nom).Range("C6:D6")
 
(Sur la ligne précédente MESSAGE ERREUR : variable objet ou bloc with end with indéfinit)
 
    Set REC = REC & "_" & i = Sheets(Nom).Range("C14:D14")
 
 
    Set PAY = PAY & "_" & i = Sheets(Nom).Range("C15:D15")
 
 
    Set DS = DS & "_" & i = Sheets(Nom).Range("C4:D4")
 
 
    Set SF = SF & "_" & i = Sheets(Nom).Range("C7:D7")
 
 
    Set VD = VD & "_" & i = Sheets(Nom).Range("C8:D8")
 
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set AMCCY1 = AMCCY1 & "_" & i = Sheets(Nom).Range("D11")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    End If
 
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D11")
    End If
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C11")
    Else
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C12")
    End If
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C12")
    Else
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C11")
    End If
 
    Set RATE = RATE & "_" & i = Sheets(Nom).Range("C13:D13")
 
   Next i
 
 
'   Transfer PO data
 
 Dim intcount As Integer
    For intcount = 1 To 11
        For i = 1 To 50
            Select Case intcount
            Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
            Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
            Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
            Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
            Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
            Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
            Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
 
                    'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
(dans cette ligne il m affiche message erreur qualificater incorecte) 
 
            Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
 
                     'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
(dans cette ligne il m affiche message erreur qualificater incorecte) 
 
 
            Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
            Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
            Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
        End Select
        Next i
    Next intcount
 
End Sub
 
Sub contpart()
 
'Trouver la contrp
 
Dim TheCell As Range
 
'on recherche dans cet interval de cellule si un mot existe
'On va donc boucler sur chaque cellule et tester son contenu
For Each TheCell In Worksheets(Nom).Range("C14:D15")
    'For va executer le code autant de fois que de cellule contenu dans l'interval C14:D14
    'A chaque execution TheCEll representera la cellule pointé par la boucle For
    '1ere execution thecell correspond a C14, 2eme execution TheCell correspond a D14
    '3eme execution TheCEll correspond a C15, 4eme execution TheCell correspond a D15
 
    'on regarde le contenu et on choisi ce que l'on doit mettre a la place en fonction de celui ci
    If TheCell.Value = "DEUT" Then
        'On change la valeur contenu dans TheCell
        TheCell.Value = "DEUTSCHE BANK FFT"
    ElseIf TheCell.Value = "CITINY" Then
        TheCell.Value = "CITIBANK NEW YORK"
    End If
Next ' on retourne au For et TheCell represente la cellule suivante
End Sub
 
Sub TypOpe()
 
Dim Ope As Variant
Dim today As Date
 
 
Ope = Sheets(Sheets.Count).Range("F27")
 
today = Date
 
    If Ope = today Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TODAY"
    End If
 
    If Ope = today + 1 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TOM"
    End If
 
    If Ope = today + 2 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "SPOT"
    End If
 
    If Ope = today + 3 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "FORW"
    End If
 
End Sub
 
 
Sub transvalneg()
 
 
Dim TheCel As Range
 
For Each TheCel In Sheets(Sheets.Count).Range("D11: D12 ")
 
    If TheCel.Value < 0 Then
        TheCel.Value = TheCel * -1
    ElseIf TheCel.Value > 0 Then
        TheCel.Value = TheCel
    End If
Next
End Sub

ps : après c est 3 messages d'erreur, je sais pas comment deja activer le tout par un double click ..... si le code que j ai rédigé selectionnera CL_1 et REC_1 et PAY_1 .... jusq a RATE_1 pour créer le ticket correspondant au numero du ticket inclut en colone D et pr la ligne i qui va elle varier ??? je reste perpelexe

**Philippe Tulliez** · 26/01/2011, 02h04

Bonsoir,
Je me demande si tu tiens compte de toutes les remarques et conseils que l'on te donne et notamment concernant les SELECT.
Tu ne vas jamais t'en sortir à continuer dans cette voie et tu vas au devant de multiples bugs.
Un simple exemple

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
 
    Rows("4:4").Select
    Selection.RowHeight = 15.75
    Rows("5:5").Select
    Selection.RowHeight = 15.75
    Rows("6:6").Select
    Selection.RowHeight = 15.75
    Rows("7:7").Select
    Selection.RowHeight = 15.75
    Rows("8:8").Select
    Selection.RowHeight = 15.75
    Rows("9:9").Select
    Selection.RowHeight = 15.75
    Rows("10:10").Select
    Selection.RowHeight = 15.75
    Rows("11:11").Select
    Selection.RowHeight = 15.75
    Rows("12:12").Select
    Selection.RowHeight = 15.75
    Rows("13:13").Select
    Selection.RowHeight = 15.75
    Rows("14:14").Select
    Selection.RowHeight = 15.75
    Rows("15:15").Select
    Selection.RowHeight = 15.75
    Rows("16:16").Select
    Selection.RowHeight = 15.75

Peut de résumer à

Code :

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

1
2
 
  Rows("4:14").RowHeight = 15.75

Outre le fait que c'est plus propre, c'est plus rapide et ceci n'est qu'un petit exemple.

**MarcelG** · 26/01/2011, 08h37

Bonjour Alexandrek, Bonjour le Forum,

Si tu veux bien, on va résoudre les questions posées par ton projet progressivement.

1 - Au niveau de ta déclaration de variable (voir le tutoriel de Silkyroad).
En entête de module

Code :

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

Public

porte ta variable au niveau du projet,
tandis que

Code :

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

Dim

la porte au niveau du module.
Je ne suis pas sûr que tes variables aient besoin de se porter au niveau du projet

2 -

Code :

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

Sheets(Sheets.Count)

désigne forcément la dernière feuille puisque l'indice de la collection Sheets est le nombre de feuilles de ton classeur.
Sinon, il te faut choisir un autre indice

3 - Si tu souhaites balayer les feuilles de ton classeur, alors tu peux utiliser la méthode For...Next
Exemple

Code :

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

1
2
3
4
5
6
7
Dim wk As workshheet
 For Each wk In ThisWorkbook.Worksheets
        If wk.Name = Sheets(Sheets.Count).Range("D27").Value Then
              'action
              Exit For
        End If
  Next wk

Prends déjà en compte ces remarques, et, par pitié, enlève les

Code :

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

Select

et

Code :

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

Selection

A plus

**alexandrek** · 26/01/2011, 08h44

merci j ai oublié de modifier cela avant de reposter mon code

je dois laisser les public vu q ces variables vont etre à nouveau appeler car
je veux activer toutes ces macros au niveau d un click et tout va se derouler au niveau du classeur
mis ds thisworkbook

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
 
Private Sub Workbook_Open()
 
Call CréatNoms
 
 
End Sub
 
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
'Si tu clique Droit sur une cellule de la colone D il exécute les procédures qui se trouvent dans un module
 
If Target.Count = Sheets(Sheets.Count) And Target.Row > 26 And Target.Column = 4 Then
 
 
 
Call select_data_ 'nom des sub de ton module
Call Transf_Data
Call varcop
Call contpart
Call TypOpe
Call transvalneg
 
 
Exit Sub
 
End Sub

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
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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
 
 
Option Explicit ' pour obliger a declarer toutes tes variables
 
Public i As Integer
Public Nom As String
Public MaFeuille As Worksheet
Public message As String
Public MaNewFeuille As Worksheet
 
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
 
 
Set débnoms = Sheets(Sheets.Count).Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each débnoms In listnoms
    For i = 1 To 10
        ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
    Next
Next
 
'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
End Sub
 
Public Sub select_data_()
 
 
 
For i = 1 To 10
        If Selection = Range("D" & i) Then
        Selection = Range("A" & i, ActiveCell.Offset(0, 12))
        End If
Next i
 
 
 
 
End Sub
 
 
 
Sub Transf_Data()
'
' Transf_Data Macro
'
'
'   Création nouvelle page avec le numero du deal
 
Set MaFeuille = Sheets(Sheets.Count)
 
Nom = Sheets(Sheets.Count).Range("D27").Value
 
'On verifie que le nom n'existe pas déjà
On Error Resume Next 'en cas d'erreur, on continu sans generer d'erreur
Set MaNewFeuille = Sheets(Nom)
On Error GoTo 0 'on réactive la gestion d'erreur
'On verifie si la variable a obtenu un objet ou non
If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
 
 
'Sinon on continu
'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
 
'Renome la nouvelle feuille
MaNewFeuille.Name = Nom
 
 
 
'   Creation tab et mise en page
 
 
Sheets("REF").Select
Range("A1:E17").Select
    Selection.Copy
    Sheets(Nom).Select
    ActiveSheet.Paste
 
    Columns("B:B").ColumnWidth = 20.29
    Columns("C:C").ColumnWidth = 6.29
    Columns("D:D").ColumnWidth = 15.43
    Rows("3:3").RowHeight = 20.25
    Rows("4:4").RowHeight = 15.75
    Rows("5:5").RowHeight = 15.75
    Rows("6:6").RowHeight = 15.75
    Rows("7:7").RowHeight = 15.75
    Rows("8:8").RowHeight = 15.75
    Rows("9:9").RowHeight = 15.75
    Rows("10:10").RowHeight = 15.75
    Rows("11:11").RowHeight = 15.75
    Rows("12:12").RowHeight = 15.75
    Rows("13:13").RowHeight = 15.75
    Rows("14:14").RowHeight = 15.75
    Rows("15:15").RowHeight = 15.75
    Rows("16:16").RowHeight = 15.75
 
    Range("C4:D4").ClearContents
 
     Range("C6:D8").ClearContents
 
    Range("C10:D16").ClearContents
 
 
 
    Range("C13:D13").Font.Bold = False And Font.Bold = True And Font.Italic = False And Font.Italic = True
 
 End Sub
 
 
'   Déclarer variables à copier
 
Sub varcop()
 
    Dim CLI As Range
 
    Dim REC As Range
 
    Dim PAY As Range
 
    Dim DS As Range
 
    Dim SF As Range
 
    Dim VD As Range
 
    Dim AMCCY1 As Range
 
    Dim AMCCY2 As Range
 
    Dim CCYO As Range
 
    Dim CCYT As Range
 
    Dim RATE As Range
 
 
 
'  Determine destination variables ds "deal" worksheet
 
 For i = 1 To 10
 
    Set CLI = CLI & "_" & i = Sheets(Nom).Range("C6:D6")
 
    Set REC = REC & "_" & i = Sheets(Nom).Range("C14:D14")
 
 
    Set PAY = PAY & "_" & i = Sheets(Nom).Range("C15:D15")
 
 
    Set DS = DS & "_" & i = Sheets(Nom).Range("C4:D4")
 
 
    Set SF = SF & "_" & i = Sheets(Nom).Range("C7:D7")
 
 
    Set VD = VD & "_" & i = Sheets(Nom).Range("C8:D8")
 
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set AMCCY1 = AMCCY1 & "_" & i = Sheets(Nom).Range("D11")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    End If
 
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
    Else
    Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D11")
    End If
 
    If Worksheets("2401").Range("G27").Value > 0 Then
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C11")
    Else
    Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C12")
    End If
 
    If Worksheets("2401").Range("H27").Value < 0 Then
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C12")
    Else
    Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C11")
    End If
 
    Set RATE = RATE & "_" & i = Sheets(Nom).Range("C13:D13")
 
   Next i
 
 
'   Transfer PO data
 
 Dim intcount As Integer
    For intcount = 1 To 11
        For i = 1 To 10
            Select Case intcount
            Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
            Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
            Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
            Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
            Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
            Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
            Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
 
                    'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
 
            Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
 
                     'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
 
            Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
            Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
            Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
        End Select
        Next i
    Next intcount
 
End Sub
 
Sub contpart()
 
'Trouver la contrp
 
Dim TheCell As Range
 
'on recherche dans cet interval de cellule si un mot existe
'On va donc boucler sur chaque cellule et tester son contenu
For Each TheCell In Worksheets(Nom).Range("C14:D15")
    'For va executer le code autant de fois que de cellule contenu dans l'interval C14:D14
    'A chaque execution TheCEll representera la cellule pointé par la boucle For
    '1ere execution thecell correspond a C14, 2eme execution TheCell correspond a D14
    '3eme execution TheCEll correspond a C15, 4eme execution TheCell correspond a D15
 
    'on regarde le contenu et on choisi ce que l'on doit mettre a la place en fonction de celui ci
    If TheCell.Value = "DEUT" Then
        'On change la valeur contenu dans TheCell
        TheCell.Value = "DEUTSCHE BANK FFT"
    ElseIf TheCell.Value = "CITINY" Then
        TheCell.Value = "CITIBANK NEW YORK"
    End If
Next ' on retourne au For et TheCell represente la cellule suivante
End Sub
 
Sub TypOpe()
 
Dim Ope As Variant
Dim today As Date
 
 
Ope = Sheets(Sheets.Count).Range("F27")
 
today = Date
 
    If Ope = today Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TODAY"
    End If
 
    If Ope = today + 1 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "TOM"
    End If
 
    If Ope = today + 2 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "SPOT"
    End If
 
    If Ope = today + 3 Then
        Sheets(Sheets.Count).Select
        Range("C7:D7") = "FORW"
    End If
 
End Sub
 
 
Sub transvalneg()
 
 
Dim TheCel As Range
 
For Each TheCel In Sheets(Sheets.Count).Range("D11: D12 ")
 
    If TheCel.Value < 0 Then
        TheCel.Value = TheCel * -1
    ElseIf TheCel.Value > 0 Then
        TheCel.Value = TheCel
    End If
Next
End Sub

A travers un double click d'une cellule ds la colonne D d'une page selectionnée qui peut etre la page 2401 ou autre par exemple (dans mon code la dernière du classeur car j arrive pas à le faire marcher pr une page selectionnée ) , je veux faire remonter toutes les données de la ligne de la colone A à M .... correspondant au numero d 'un "deal" (contenu donc ds la colonne D)
ensuite renomer chaque cellule A1 par exemple à M1 (comme vous m avez indiqué auparavant, ce qui marche tres bien d'ailleurs )

ensuite il faut q je rassemble CLI_1 avec REC_1 avec PAY_1 .... jusqu'à RATE_1
pour envoyer chaque donner ds un ticket resumant mon deal

dans mon code j'ai un gros probl car qd je fais reference à une page selectionée il me renvoie trop d erreur tandis que qd je mets la derniere page du classeur ça marche

je vous joins tout mon code mais je bloque bcp qd meme faut avouer lol

**MarcelG** · 26/01/2011, 09h17

Alexandrek,

J'ai l'impression que tu ne comprends pas ce que tu écris.

1 -

Code :

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

1
2
3
'Si tu clique Droit sur une cellule de la colone D il exécute les procédures qui se trouvent dans un module
 
If Target.Count = Sheets(Sheets.Count) And Target.Row > 26 And Target.Column = 4 Then

Code :

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

Target.Count

est contradictoire avec "Si tu cliques sur 1 cellule"

A quoi te sert cette condition ? (tester sur le nombre de cellules de ton objet Target)

2 - Ensuite, pour citer ton code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
 
Set débnoms = Sheets(Sheets.Count).Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each débnoms In listnoms
    For i = 1 To 10
        ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
    Next
Next

C'est du n'importe quoi!

Je t'ai indiqué

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
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
Dim nom as range 
 
Set débnoms = Sheets(Sheets.Count).Range("A26")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each nom In listnoms
    For i = 1 To 10
        ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
    Next
Next

Tu auras ainsi 11*10 = 121 noms créés.
Essaie de bien comprendre ce code, pose les questions éventuelles, et dis-nous son utilité.

**alexandrek** · 26/01/2011, 10h02

en faite à travers ce code je veux nommer chaque cellule

CLI_1
CLI_2
.
.
REC_1
.. pour ensuite rassembler tout les "'cli ET rec et pay et .... "_ 1 ensemble et que ces données soient regroupées pr créer un ticket de transaction .

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
 
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
'Si tu clique Droit sur une cellule de la colone D il exécute les procédures qui se trouvent dans un module
 
If Target = Sheets(Sheets.Count) And Target.Row > 26 And Target.Column = 4 Then
 
Call select_data_ 'nom des sub de ton module
Call Transf_Data
Call varcop
Call contpart
Call TypOpe
Call transvalneg
 
 
Exit Sub
 
End Sub

en faite la j'ssaye differente methode pr dire q qd je clique de la colone D ce clique actionne les macros

peut etre ce code irait je sais pas trop

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
 
Public Sub select_data_()
 
 
 
For i = 1 To 10
        If Selection = Range("D" & i) Then
        Selection = Range("A" & i, ActiveCell.Offset(0, 12))
        End If
Next i
 
 
 
 
End Sub

**Philippe Tulliez** · 26/01/2011, 10h27

Bonjour,

en faite la j'ssaye differente methode pr dire q qd je clique de la colone D ce clique actionne les macros
peut etre ce code irait je sais pas trop

Lis tu les réponses que l'on te fait ?

Hier à 18h06 sur un autre post traitant du même sujet, je t'ai apporté une réponse qui me semble fort appropriée par rapport à ce que tu demandes.

Bonsoir,
Une suggestion. Personnellement j'utiliserais la procédure événementielle Worksheet_SelectionChange de la feuille, qui exécuterait la boucle dès que l'on a cliqué sur une cellule de la colonne D

Code :

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

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 With Target
  If .Column = 4 Then ' Vérifie si l'on a cliqué sur la colonne D
   MsgBox "Vous avez cliqué sur une cellule de la colonne D " & .Address
  End If
 End With
End Sub

Si l'on veut que le code réagisse uniquement si l'on est sur la colonne D ET sur une ligne inférieure à 10 (en partant du même code que ci-dessus).

Code :

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

If .Column = 4 And .Row < 10 Then

Es-tu sûr de vouloir faire une sélection et pas plutôt agir sur ces cellules en modifiant une ou plusieurs de leurs propriétés ?
Comme ceci par exemple :

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 With Target
  If .Column = 4 And .Row < 10 Then
   .Offset(0, -1).Interior.Color = 5
   .Offset(0, 1).Interior.Color = 5
   End If
 End With
End Sub

**alexandrek** · 26/01/2011, 11h32

merci oui j'ai tres bien lu votre réponse et vous en remercie mais

en faite dans cette selection je ne veux pas modifier la propriété mais juste rassembler les données correspondant a la ligne ou je clique ds la colonne D pour ensuite les envoyer ds une autre page pr creer un tableau

je suis un peu débutant dc je sais pas si la propriété me servirait à faire cela ....

si vous voyez mon code en faite qd je vais cliquer il faut q les cellules a coté associées a la cellule d .... se stocke pr etre envoyées ds un page ....

je sais pas trop comment bien faire et peut etre vouloir trop bien faire et je me trompe

**MarcelG** · 26/01/2011, 11h32

Alexandrek,

Proposition de Code à adapter

Si tu as dans ta 1ère feuille en cellule A9, B9 et C9 les libellés
Cli Rec Pay

Pour la création des noms (rappel)

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
Option Explicit ' pour obliger a declarer toutes tes variables
 
Public Sub CréatNoms()
 
Dim débnoms As Range
Dim listnoms As Range
Dim nom As Range
Dim i As Integer
 
Set débnoms = Range("A9")
 
Set listnoms = Range(débnoms, débnoms.End(xlToRight))
 
For Each nom In listnoms
    For i = 1 To 10
        ActiveWorkbook.Names.Add Name:=nom.Value & "_" & i, RefersToR1C1:=nom.Offset(i, 0)
    Next
Next
 
End Sub

Dans l'éditeur de ta feuille 1 (attention : à adapter), le code suivant te permettra de copier les cellules correspondantes à la ligne de la cellule à Cliquer (à partir de D10) vers la cellule M1.

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim listdon As Variant
Dim lign As Byte
Dim donexp As String
With Target
        If .Column <> 4 Or .Row < 10 Then Exit Sub
        lign = .Row - 9
        listdon = Array("Cli", "Rec", "Pay")
        donexp = ""
        For Each donnée In listdon
                donexp = donexp & Range(donnée & "_" & lign)
        Next donnée
        Sheets(1).Range("M1").Value = donexp
End With
 
End Sub

Reprends-bien ce code pour le comprendre, pose les questions et adapte-le (exercice formateur) à ton cas.

**alexandrek** · 26/01/2011, 13h40

Ce code n a rien a voir avec le mien et il parait tres claire ...

peut on faire varier la page par contre car la je vois elle correspond à la page 1 et de plus on doit insérer le code ds la fenetre code de cette page ....

ne peut on pas déclarer une variable

Code :

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

1
2
3
4
5
public sub sh as reference 
 
sh = sheet.activate 
 
end sub

et ensuite remplacer

Code :

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

Sheets(1).Range("M1").Value = donexp

par

Code :

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

Sheets(sh).Range("M1").Value = donexp

et mettre ce code ds l onglet code de Thisworkbook

il y a une chose que je comprends pas

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
If .Column <> 4 Or .Row < 10 Then Exit Sub
        lign = .Row - 9
 
' Pk la on fait Row-9, pour selectioner la ligne 1entre 9 et 10 ; si je veux faire la ligne 27 je mets <27 lign = .row -26  ''
 
        listdon = Array("Cli", "Rec", "Pay")
        donexp = ""
        For Each donnée In listdon
                donexp = donexp & Range(donnée & "_" & lign)
        Next donnée
        Sheets(1).Range("M1").Value = donexp
 
' et pk pas sheets(sh). range("M" & lign), sachant q qd ça sera un clique sur D9 il faudra copier les données jusqu'à M9"

**MarcelG** · 26/01/2011, 15h06

Alexandrek,

Pour les 2 premiers encarts,

Tout simplement sans aller chercher l'objet ThisWorkbook
remplacer

Code :

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

Sheets(sh).Range("M1").Value = donexp

par

Code :

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

ActiveSheet.Range("M1").Value = donexp

Mais cette écriture n'est pas nécessaire.
Pour le 3ème encart, en effet, relis tout ce qui est écrit.
Ton adaptation s'effectuera
- sur la ligne où sont écrits les titres de ta base (dans mon exemple à partir de la cellule A9 sur la ligne 9.
- sur la destination de ta "copie"
Si tu souhaites que celle-ci soit en colonne "M" et à la même ligne que la cellule cliquée, alors elle peut être définie par

Code :

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

Range("M" & .Row).Value = donexp

et non pas Range("M" & lign) car lign désigne le nom de ta cellule(Cli_1 = A10)

Nuance avec mon précédent code : il n'est pas besoin de préciser la feuille, si cette feuille est celle dont tu gères l'évènement SelectionChange.

Si tu as une question, s'il te plaît, pose-là hors de ton code.

**alexandrek** · 28/01/2011, 12h23

Merci beaucoup pour votre aide

Probl sur boucle [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager