Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » dos módulos independientes

Excel - dos módulos independientes

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

dos módulos independientes

Publicado por Juan VBA (4 intervenciones) el 04/06/2017 21:57:54
Hola amigos,
Estoy programando una hoja excel en VBA. El caso es que una parte del código lo he escrito en un módulo y la otra parte en otro módulo. Ambos programas funcionan perfectamente. Pero cuándo los ejecuto a la vez me da problemas. ¿Hay alguna manera que se puedan ejecutar dos módulos a la vez e independientemente sin que uno afecte al otro?
Gacias,
JR
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

dos módulos independientes

Publicado por JuanC (1237 intervenciones) el 04/06/2017 22:59:20
algo no cierra, los módulos no se ejecutan, podrías publicar el libro y contar qué querés hacer?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

dos módulos independientes

Publicado por Juan VBA (4 intervenciones) el 05/06/2017 07:35:13
JuanC,
Muchas gracias por su respuesta. Pues, estoy haciendo el juego del ping pong (también conocido por pong o telepong) en Excel. He conseguido, en un módulo, que la celda activa coloreada haga de pelotita y me rebote dentro de unos márgenes. Luego también he logrado crear en otro módulo una pala vertical para poder jugar. El problema es que tanto la celda-pelota y la barra vertical se basan en la celda activa. En otras palabras, si la pala sube también lo hará la pelota y dejara de rebotar...
Por eso quiero que los módulos funcionen por separado....
Gracias de nuevo.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

dos módulos independientes

Publicado por JuanC (1237 intervenciones) el 05/06/2017 12:11:41
insisto, sin ver el código no puedo hacer nada...
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

dos módulos independientes

Publicado por Juan VBA (4 intervenciones) el 15/06/2017 22:56:37
Hola Juan,
He andado muy liado. Disculpa la tardanza he tenido una temporada un poco complicada. Te adjunto el código. Hay que copiar cada trozo de código en su sitio. Es decir, en "this workbook" un trozo, en módulo 1 y 2 el resto. Viene indicado.
Saludos,
JR


This workbook:
============

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
Private Sub workbook_open1()
 
ColorAnterior = ActiveCell.Interior.Color
 
Set celdaAnterior = ActiveCell
 
End Sub
 
 
 
Private Sub workbook_sheetselectionchange(ByVal sh As Object, ByVal target As Range)
 
On Error Resume Next
 
celdaAnterior.Interior.Color = ColorAnterior
 
ColorAnterior = ActiveCell.Interior.Color
 
ActiveCell.Interior.Color = RGB(153, 204, 0)
 
Set celdaAnterior = ActiveCell
 
End Sub
 
 
 
Private Sub workbook_beforeSave(ByVal saveAsUI As Boolean, cancel As Boolean) 'esto es para que la pelota no suba o baje cuando presionamos up o down

 
On Error Resume Next
 
celdaAnterior.Interior.Color = ColorAnterior
 
End Sub
 
 
 
Private Sub workbook_open() 'esto es para que la pelota no suba o baje cuando presionamos up o down

 
Application.OnKey "{up}", "cancelarUP"
 
Application.OnKey "{down}", "cancelarDOWN"
 
End Sub
 
 
 
Private Sub workbok_beforeclose(cancel As Boolean) 'esto es para que la pelota no suba o baje cuando presionamos up o down

 
Application.OnKey "{up}", ""
 
Application.OnKey "{down}", ""
 
End Sub



Módulo 1:
========

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
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
Option Explicit
 
'Declaración de las variables que hay en ThisWorkBook

 
Public celdaAnterior As Range
 
Public ColorAnterior As Long
 
'Declaración de las variables que hay en el módulo en que trabajamos

 
Dim b, c, d, i, cociente, residuo, residuo_2, z, x, m, l, t, w, tt, ll As Integer
 
 
Sub cancelarUP()
 
Application.EnableEvents = False
 
If Intersect(ActiveCell, Range("b5:w35")) Is Nothing Then
 
ActiveCell.Offset(-1).Select
 
Application.EnableEvents = True
 
End If
 
End Sub
 
 
 
Sub cancelarDOWN() 'esto es para que la celda activa no suba o baje con el up & down

 
Application.EnableEvents = False
 
If Intersect(ActiveCell, Range("b5:w35")) Is Nothing Then
 
ActiveCell.Offset(1).Select
 
Application.EnableEvents = True
 
End If
 
End Sub
 
 
 
Sub auto_open()
 
Columns("A:w").Select
 
Selection.ColumnWidth = 3 'representamos el ancho de filas y columnas del area de interés

 
'Range("A5:A35").Interior.ColorIndex = 6 'coloreamos de amarillo el borde superior

 
Range("A5:W5").Interior.ColorIndex = 6 'coloreamos de amarillo el borde izquierdo

 
Range("w5:W35").Interior.ColorIndex = 6 'coloreamos de amarillo el borde inferior

 
Range("A35:W35").Interior.ColorIndex = 6 'coloreamos de amarillo el borde derecho

 
Range("B6:V34").Interior.ColorIndex = 2 'coloreamos de blanco el área comprendida dentro de los bordes

 
Range("A1:z1").Clear 'cada vez que se inicializa el juevo las variables de la primera fila se borran

 
Range("a1:zz4").Interior.ColorIndex = 2
 
Cells(15, 2).Select 'la pelota empieza en la celda situada en la fila 15 y columna 2

 
ActiveWindow.DisplayVerticalScrollBar = False 'de esta forma se elimina la posibilidad de utilizar la barra de desplazamiento vertical

 
 
 
tiempo 'le dice al programa que vaya al siguiente programa llamado tiempo

 
 
 
End Sub
 
 
 
Sub tiempo()
 
 
 
b = Range("a1")
 
c = b + 1
 
Range("A1").Value = c
 
 
 
m = Range("Y1").Value
 
w = 1 + Range("X1").Value Mod 2
 
Range("Y1").Value = w
 
Range("Z1").Value = w Mod 2
 
 
 
If ActiveCell.Column = 22 Then
 
t = Range("x1").Value
 
l = t + 1
 
Range("X1").Value = l
 
End If
 
 
 
If ActiveCell.Column = 1 Then
 
tt = Range("x1").Value
 
ll = tt + 1
 
Range("w1").Value = ll
 
    Else
 
    If ll >= 5 Then
 
    Range("X1").Value = 0
 
    Range("Z1").Value = 0
 
    Range("Y1").Value = 2
 
    End If
 
End If
 
 
 
 
 
Application.OnTime Now + TimeValue("00:00:01"), "tiempo"
 
 
 
residuo = c Mod 10
 
cociente = c \ 10
 
residuo_2 = cociente Mod 2
 
 
 
Range("c1").Value = cociente
 
Range("b1").Value = residuo
 
Range("d1").Value = residuo_2
 
 
 
If Range("X1").Value < 2 And Range("Z1").Value = 1 And Range("Y1").Value = 1 Then
 
    If ActiveCell.Column = 1 Then
 
    Range("A1:M1").Clear
 
    ActiveCell.Offset(-1, 1).Select
 
    Else
 
    If ActiveCell.Row = 34 Then
 
    Range("H1").Value = ActiveCell.Column
 
    ActiveCell.Offset(-1, -1).Select
 
    Else
 
    If ActiveCell.Column < Range("H1").Value And Range("H1").Value <> 0 And ActiveCell.Column > 1 Then
 
    ActiveCell.Offset(-1, -1).Select
 
    Else
 
    If ActiveCell.Column = 22 And ActiveCell.Row > 6 Then
 
    Range("G1").Value = ActiveCell.Row
 
    ActiveCell.Offset(1, -1).Select
 
    Else
 
    If ActiveCell.Column < 22 And ActiveCell.Row > Range("G1").Value And Range("G1").Value <> 0 And ActiveCell.Column <> 1 Then
 
    ActiveCell.Offset(1, -1).Select
 
    Else
 
    If ActiveCell.Column > 1 And ActiveCell.Row = 6 Then
 
    ActiveCell.Offset(1, 1).Select
 
    Range("F1").Value = ActiveCell.Column - 1
 
    Else
 
    If ActiveCell.Row > 6 And ActiveCell.Column >= Range("F1").Value And Range("F1").Value <> 0 Then
 
    ActiveCell.Offset(1, 1).Select
 
    Else
 
    If ActiveCell.Column >= 1 And ActiveCell.Row > 6 And Range("F1").Value = 0 Then
 
    ActiveCell.Offset(-1, 1).Select
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
End If
 
 
 
If Range("X1").Value < 2 And Range("Z1").Value = 0 And Range("Y1").Value = 2 Then
 
 
 
    If ActiveCell.Row = 5 And ActiveCell.Column = 2 Then
 
    ActiveCell.Offset(1, 1).Select
 
    Else
 
    If ActiveCell.Column = 1 Then
 
    Range("A1:M1").Clear
 
    ActiveCell.Offset(-1, 1).Select
 
    Else
 
    If ActiveCell.Row = 34 Then
 
    Range("H1").Value = ActiveCell.Column
 
    ActiveCell.Offset(-1, -1).Select
 
    Else
 
    If ActiveCell.Column < Range("H1").Value And Range("H1").Value <> 0 And ActiveCell.Column > 1 Then
 
    ActiveCell.Offset(-1, -1).Select
 
    Else
 
    If ActiveCell.Column = 22 And ActiveCell.Row > 6 Then
 
    Range("G1").Value = ActiveCell.Row
 
    ActiveCell.Offset(1, -1).Select
 
    Else
 
    If ActiveCell.Column < 22 And ActiveCell.Row > Range("G1").Value And Range("G1").Value <> 0 And ActiveCell.Column <> 1 Then
 
    ActiveCell.Offset(1, -1).Select
 
    Else
 
    If ActiveCell.Column > 1 And ActiveCell.Row = 6 Then
 
    ActiveCell.Offset(1, 1).Select
 
    Range("F1").Value = ActiveCell.Column - 1
 
    Else
 
    If ActiveCell.Row > 6 And ActiveCell.Column >= Range("F1").Value And Range("F1").Value <> 0 Then
 
    ActiveCell.Offset(1, 1).Select
 
    Else
 
    If ActiveCell.Column >= 1 And ActiveCell.Row > 6 And Range("F1").Value = 0 Then
 
    ActiveCell.Offset(-1, 1).Select
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
    End If
 
End If
 
 
 
If Range("X1").Value >= 2 Then
 
 
 
   If ActiveCell.Row = 6 And ActiveCell.Column = 1 Then
 
   ActiveCell.Offset(1, 1).Select
 
   Range("X1").Value = 1
 
   Range("Z1").Value = 0
 
   Range("Y1").Value = 2
 
   Else
 
   If ActiveCell.Row = 35 Then
 
   Range("k1").Value = ActiveCell.Column
 
   ActiveCell.Offset(-1, 1).Select
 
   Range("F1").Clear
 
   Range("I1").Clear
 
   Range("G1").Clear
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column = 22 Then
 
   Range("F1").Clear
 
   Range("I1").Clear
 
   Range("G1").Value = 35
 
   ActiveCell.Offset(-1, -1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column > 1 And ActiveCell.Row > Range("I1").Value And Range("I1").Value <> 0 Then
 
   ActiveCell.Offset(1, 1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column = 1 And ActiveCell.Row > 6 Then
 
   Range("G1").Value = 23
 
   Range("I1").Value = ActiveCell.Row
 
   ActiveCell.Offset(1, 1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column > 1 And ActiveCell.Row = 6 Then
 
   Range("H1").Value = ActiveCell.Column
 
   ActiveCell.Offset(1, -1).Select
 
   Range("F1").Value = ActiveCell.Column - 1
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Row > 6 And ActiveCell.Column <= Range("H1").Value And Range("F1").Value <> 0 Then
 
   ActiveCell.Offset(1, -1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column = 22 And ActiveCell.Row > 6 Then
 
   Range("G1").Value = ActiveCell.Row
 
   ActiveCell.Offset(-1, -1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Column < 22 And ActiveCell.Row < Range("G1").Value And ActiveCell.Column <> 1 Then
 
   ActiveCell.Offset(-1, -1).Select
 
   Else
 
   If Range("X1").Value >= 2 And ActiveCell.Row < 35 And ActiveCell.Column > Range("k1").Value And ActiveCell.Column < 22 Then
 
   ActiveCell.Offset(-1, 1).Select
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
   End If
 
End If
 
End Sub





Módulo 2:
=======

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
Option Explicit
 
Sub pintar()
 
' pinto de blanco toda la columna para que siempre se reinicie sin dejar restos negros que pudieran haber de anteriores

 
' ocasiones

 
Range("a6:a34").Interior.ColorIndex = 2 'una manera de borrar todo lo que haya antes

 
Cells(19, 1).Select 'esto es para centrar la barra en el area

 
Range("a16:a22").Interior.ColorIndex = 1 'esto es para centrar la barra en el area

 
Cells(5, 1).Interior.ColorIndex = 6 'esto lo hacemos para que a5 siempre sea amarillo

 
Cells(35, 1).Interior.ColorIndex = 6 'esto lo hacemos para que a35 siempre sea amarillo

 
Range("a6:a15").Interior.ColorIndex = 2 'esto es para pintar de blanco posibles cueldas negras que hayan quedado en ejecuciones anteriores.

 
Range("a23:a34").Interior.ColorIndex = 2 'esto es para pintar de blanco posibles cueldas negras que hayan quedado en ejecuciones anteriores.

 
'dejamos el resto de celdas bonitas:

 
Range("a36:zz100").Interior.ColorIndex = 2
 
Range("a1:zz4").Interior.ColorIndex = 2
 
Range("x1:zz100").Interior.ColorIndex = 2
 
' pintamos de negro la celda activa porque se habrá blanqueado

 
ActiveCell.Interior.ColorIndex = 1
 
auto 'inicializamos el programa de subir y bajar

 
 
 
End Sub
 
 
 
Sub auto()
 
 
 
' Estas teclas, ejecutan el procedimiento específico "hola y hola2" cuando se presiona una "up" y "down" respectivamente.

 
' En otras palabras, cuando apretamos la felca arriba o abajo tiene que suceder algo. Este algo es el programa hola y hola2.

 
Application.OnKey "{up}", "hola"
 
Application.OnKey "{down}", "hola2"
 
 
 
End Sub
 
 
 
Sub hola()
 
On Error Resume Next
 
Dim i  As Integer
 
Cells(5, 1).Interior.ColorIndex = 6
 
Cells(35, 1).Interior.ColorIndex = 6
 
 
 
' Aquí lo que hago es que cada vez que le doy click arriba, la celda considerada sea la nueva celda.

 
' Es decir, si no pongo "ActiveCell.Row - 1" la celda activa será por ejemplo la de la fila 18, pero despues

 
' del click (up) se situará en la 17, creando un desfase entre la nueva celda activa y la anterior. En otras palabras,

 
' La celda necesaria es la 17 pero estaríamos considerando aun la 18. Lo que queremos es que se trabaje siempre con

 
' la celda de después del click.

 
i = ActiveCell.Row - 1
 
ActiveCell.Offset(-1, 0).Select
 
' Barra:  Lo que vamos a hacer es pintar las celdas por encima y por debajo de la celda que se mueve. veamos:

 
' En este se pinta la propia celda que se mueve:

 
Application.Cells(i, 1).Interior.ColorIndex = 1
 
 
 
' Se pinta de negro las celdas que acompaña a la que se mueve:

 
Application.Cells(i - 1, 1).Interior.ColorIndex = 1
 
Application.Cells(i - 2, 1).Interior.ColorIndex = 1
 
Application.Cells(i - 3, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 1, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 2, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 3, 1).Interior.ColorIndex = 1
 
 
 
' Se pinta de blanco las celdas que no queremos que se vean por debajo de la última negra.

 
' Sino se pone esta función quedará pintada de negro al subir.

 
Application.Cells(i + 4, 1).Interior.ColorIndex = 2
 
 
 
' Esta función lo que hace es impedir que se suba por encima de la celda a6. Es decir, hago que la barra se pueva entre

 
' unos márgenes.

 
Worksheets(1).ScrollArea = "a9:a35"
 
 
 
' las primeras celdas blancas

 
Application.Cells(1, 1).Interior.ColorIndex = 2
 
Application.Cells(2, 1).Interior.ColorIndex = 2
 
 
 
' Esto lo pongo porque al llegar al máximo del rango se mueve la celda activa a 5 y el tamaño de la barra se acortaria.

 
If ActiveCell.Row = 9 Then
 
Cells(5, 1).Interior.ColorIndex = 6
 
Cells(35, 1).Interior.ColorIndex = 6
 
Application.Cells(12, 1).Interior.ColorIndex = 1
 
End If
 
 
 
Dim ñ As Integer
 
For ñ = 36 To 100
 
Application.Cells(ñ, 1).Interior.ColorIndex = 2
 
Next
 
End Sub
 
 
 
Sub hola2()
 
On Error Resume Next
 
Dim i  As Integer
 
Cells(5, 1).Interior.ColorIndex = 6
 
Cells(35, 1).Interior.ColorIndex = 6
 
i = ActiveCell.Row + 1
 
If ActiveCell.Row < 31 Then
 
 
 
' barra

 
Application.Cells(i, 1).Interior.ColorIndex = 1
 
Application.Cells(i - 4, 1).Interior.ColorIndex = 2
 
Application.Cells(i - 1, 1).Interior.ColorIndex = 1
 
Application.Cells(i - 2, 1).Interior.ColorIndex = 1
 
Application.Cells(i - 3, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 1, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 2, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 3, 1).Interior.ColorIndex = 1
 
Application.Cells(i + 4, 1).Interior.ColorIndex = 2
 
Application.Cells(i + 5, 1).Interior.ColorIndex = 2
 
ActiveCell.Offset(1, 0).Select
 
Application.Cells(1, 1).Interior.ColorIndex = 2
 
' las primeras celdas blancas

 
Application.Cells(1, 1).Interior.ColorIndex = 2
 
Application.Cells(2, 1).Interior.ColorIndex = 2
 
Dim ñ As Integer
 
For ñ = 36 To 100
 
Application.Cells(ñ, 1).Interior.ColorIndex = 2
 
Next
 
 
 
If ActiveCell.Row = 31 Then 'esto lo hacemos para que a5 y a35 siempre sean amarillos

 
Cells(5, 1).Interior.ColorIndex = 6
 
Cells(35, 1).Interior.ColorIndex = 6
 
    Else
 
    If ActiveCell.Row = 30 Then 'esto lo hacemos para que a5 y a35 siempre sean amarillos

 
    Cells(35, 1).Interior.ColorIndex = 6
 
    End If
 
End If
 
Else
 
End If
 
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar