Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » error macros

Excel - error macros

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

error macros

Publicado por pedro (3 intervenciones) el 02/02/2016 22:07:43
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
Fname = Dir(ruta & "\" & nom & ".xlsx")
If Fname <> "" Then
    Kill (ruta & "\" & nom & ".xlsx")
End If
 
Wk.SaveAs Filename:=ruta & nom & ".xlsx"
 
If sigue = False Then
    MsgBox "No se ha encontrado ninguna contraparte bloqueada para la fecha de proceso " & FPROC, vbCritical
    Wk.Close
    Kill (ruta & "\" & nom & ".xlsx")
    Exit Function
End If
 
 
Public Function Lectura_Archivo(origen As String, ruta As String)
Dim linea As String
Open ruta For Input As #1

 
While Not EOF(1)
    Line Input #1, linea

    Call Corta_Datos(linea, origen)
Wend
 
Close #1

End Function
Public Function Corta_Datos(lin As String, ori As String)
Dim campos, y, u, marca As Integer
marca = 1
campos = 15
If Right(lin, 1) <> ";" Then
    lin = lin & ";"
End If
y = UBound(OPES)
OPES(y).origen = ori
OPES(y).Cliente = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).Rut_Orig = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "") //// AQUI MARCA ERROR

lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).Rut_Ficticio = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).ID_OP = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).TIPO_OP = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).FEC_INI = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).FEC_MATU = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).FEC_ET = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).NOMI1 = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).MONNOM1 = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).NOMI2 = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).NOMI2 = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).MONNOM2 = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).TRADER = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
OPES(y).HORA = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
ReDim Preserve OPES(UBound(OPES) + 1)
End Function
Function Busca_Moneda(cod As String) As String
Dim t As Integer
Busca_Moneda = ""
If IsNumeric(cod) = False Then
    Busca_Moneda = "Moneda no definida (" & cod & ")"
    Exit Function
End If
 
For t = 0 To UBound(MON)
    If cod = MON(t).CODIGO Then
        Busca_Moneda = MON(t).MONEDA
        Exit Function
    End If
Next t
If t >= UBound(MON) Then
    Busca_Moneda = "Moneda no definida (" & cod & ")"
End If
End Function
Public Function Lectura_MNE()
Dim x, ind, y As Integer
 
Workbooks.Open Filename:=RUTA_MNE & "\" & ARCH_MNE
 
Range("A1").Select
x = 3
y = UBound(OPES)
 
Do
    y = y + 1
 
    ReDim Preserve OPES(UBound(OPES) + 1)
    OPES(y).origen = "MNE"
    OPES(y).Cliente = Cells(x, 25)
    OPES(y).Rut_Orig = Cells(x, 23) & Cells(x, 24)
    OPES(y).Rut_Ficticio = ""
    OPES(y).ID_OP = Cells(x, 1)
    OPES(y).TIPO_OP = Cells(x, 20)
    OPES(y).FEC_INI = Cells(x, 3)
    OPES(y).FEC_MATU = Cells(x, 5)
    OPES(y).FEC_ET = ""
    If Cells(x, 33) = "Compra" Then
        OPES(y).NOMI1 = Cells(x, 7)
        OPES(y).MONNOM1 = Busca_Moneda(Cells(x, 6))
    Else
        OPES(y).NOMI2 = Cells(x, 7)
        OPES(y).MONNOM2 = Busca_Moneda(Cells(x, 6))
    End If
    OPES(y).ID_TRD = ""
    OPES(y).TRADER = ""
    OPES(y).HORA = ""
    x = x + 1
Loop While Cells(x, 1) <> ""
 
ActiveWorkbook.Close
End Function
Public Function Lectura_LED()
Dim x, ind As Integer
 
Workbooks.Open Filename:=RUTA_LED & "\" & ARCH_LED
 
Range("A1").Select
x = 2
ReDim Preserve BLOQUEO(1)
ind = 1
Do
    BLOQUEO(ind).TIPO_CONTRAPARTE = Cells(x, 1)
    BLOQUEO(ind).RUT = Cells(x, 2)
    BLOQUEO(ind).BUCKET = Cells(x, 3)
    BLOQUEO(ind).marca = Cells(x, 4)
    ind = ind + 1
    x = x + 1
    ReDim Preserve BLOQUEO(ind)
Loop While Cells(x, 1) <> "" And Cells(x, 2) <> "" And Cells(x, 3) <> "" And Cells(x, 4) <> ""
 
ActiveWorkbook.Close
End Function
Public Function Revision_Interfaces()
If Cells(7, 1) <> "" Then
 
    If IsDate(Cells(7, 1)) = True Then
        FPROC = Cells(7, 1)
    Else
        MsgBox "No es una fecha valida", vbExclamation, "Error"
        End
    End If
End If
If Str(FPROC) <> "" And Str(FPROC) <> " 0:00:00" And Trim(Str(FPROC)) <> "00:00:00" Then
    MsgBox "Se realizara proceso con fecha proporcionada por usuario: " & FPROC, vbExclamation, "Advertencia"
End If
RUTA_MX = Cells(2, 1)
If RUTA_MX = "" Then
    MsgBox "No se encontro la ruta para MX, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
ARCH_MX = ListarFicherosCarpeta("MX")
If ARCH_MX = "" Then
    MsgBox "No se encontro el archivo MX, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
RUTA_MNE = Cells(3, 1)
If RUTA_MNE = "" Then
    MsgBox "No se encontro la ruta para MNE, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
ARCH_MNE = ListarFicherosCarpeta("MNE")
If ARCH_MNE = "" Then
    MsgBox "No se encontro el archivo MNE, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
RUTA_LED = Cells(4, 1)
If RUTA_LED = "" Then
    MsgBox "No se encontro la ruta para LED, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
ARCH_LED = ListarFicherosCarpeta("LED")
If ARCH_LED = "" Then
    MsgBox "No se encontro el archivo LED, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
 
If Mid(ARCH_MX, 4, 8) = Mid(ARCH_MNE, 17, 8) And Mid(ARCH_MNE, 17, 8) = Mid(ARCH_LED, 4, 8) Then
    Dim RES As Integer
    RES = MsgBox("Se procesaran los archivos con fecha " & Mid(ARCH_MX, 4, 8), vbYesNo, "Fecha Proceso")
    If RES = vbNo Then
        End
    End If
    FPROC = Mid(ARCH_MX, 10, 2) & "/" & Mid(ARCH_MX, 8, 2) & "/" & Mid(ARCH_MX, 4, 4)
Else
    MsgBox "Los archivos a procesar corresponden a diferentes dias. Favor revisar" & Chr(13) & "- " & ARCH_MX & Chr(13) & "- " & ARCH_MNE & Chr(13) & "- " & ARCH_LED & Chr(13) & "Se cancela proceso!"
    End
End If
 
RUTA_REPO = Cells(5, 1)
If RUTA_REPO = "" Then
    MsgBox "No se encontro la ruta para Repositorio, se finalizara el proceso", vbCritical, "Advertencia"
    End
End If
PURGA = Cells(6, 1)
If Str(PURGA) = "" Or PURGA < 0 Then
    MsgBox "No se encontro dias para la purga, se finalizara el proceso" & Chr(13) & "Debe colocar un numero mayor o igual a 0", vbCritical, "Advertencia"
    End
End If
End Function
Public Function Copia_Interfaces()
FileCopy RUTA_MX & "\" & ARCH_MX, RUTA_REPO & "\" & ARCH_MX
FileCopy RUTA_MNE & "\" & ARCH_MNE, RUTA_REPO & "\" & ARCH_MNE
FileCopy RUTA_LED & "\" & ARCH_LED, RUTA_REPO & "\" & ARCH_LED
End Function
Public Function ListarFicherosCarpeta(tipo As String) As String
 
Dim ARCHIVOS() As String
Dim fso, Carpeta, Ficheros, archivo
Dim ruta As String
Dim numero, x As Long
Dim ext As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Creamos el objeto FileSystemObject que

'proporciona acceso al sistema de archivos de un equipo

Set fso = CreateObject("Scripting.FileSystemObject")
'definimos dos variables que necesitaremos,

'para recuperar el nombre de la carpeta, y los ficheros que haya dentro

Select Case tipo
    Case "MX"
        ruta = RUTA_MX
    Case "MNE"
        ruta = RUTA_MNE
    Case "LED"
        ruta = RUTA_LED
End Select
Set Carpeta = fso.GetFolder(ruta)
Set Ficheros = Carpeta.Files
 
ReDim Preserve ARCHIVOS(1)
For Each archivo In Ficheros
    'escribimos el nombre del fichero

    If tipo = Mid(archivo.Name, 1, 2) Then
        If Str(FPROC) <> " 0:00:00" And Trim(Str(FPROC)) <> "00:00:00" Then
            If Mid(archivo.Name, 3, 8) = Format(FPROC, "YYYYMMDD") Then 'para procesar fecha dada

                ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
            End If
        Else
            If Mid(archivo.Name, 4, 8) < Format(Date, "YYYYMMDD") Then 't-1

                ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
            End If
        End If
    ElseIf tipo = Mid(archivo.Name, 1, 3) Then
            If Str(FPROC) <> " 0:00:00" And Trim(Str(FPROC)) <> "00:00:00" Then
                If Mid(archivo.Name, 4, 8) = Format(FPROC, "YYYYMMDD") Then 'para procesar fecha dada

                    ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                    ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
                End If
            Else
                If Mid(archivo.Name, 4, 8) < Format(Date, "YYYYMMDD") Then 't-1

                    ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                    ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
                End If
            End If
        ElseIf InStr(1, archivo.Name, tipo) > 0 Then
                If Str(FPROC) <> " 0:00:00" And Trim(Str(FPROC)) <> "00:00:00" Then
                    If Mid(archivo.Name, 17, 8) = Format(FPROC, "YYYYMMDD") Then 'para procesar fecha dada

                        ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                        ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
                    End If
                Else
                    ARCHIVOS(UBound(ARCHIVOS)) = archivo.Name
                    ReDim Preserve ARCHIVOS(UBound(ARCHIVOS) + 1)
                End If
 
    End If
Next archivo
 
numero = 0
For x = 1 To UBound(ARCHIVOS) - 1
    If tipo = "MX" Then
        If Replace(Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 7), "_", "") > numero Then
            numero = Replace(Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 7), "_", "")
            ext = Right(ARCHIVOS(x), Len(ARCHIVOS(x)) - InStr(1, ARCHIVOS(x), ".") + 1)
        End If
    ElseIf tipo = "LED" Then
        If Right(ARCHIVOS(x), 3) = "xls" Then
            ext = Right(ARCHIVOS(x), Len(ARCHIVOS(x)) - InStr(1, ARCHIVOS(x), ".") + 1)
            If Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 7) > numero Then
                numero = Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 7)
            End If
        Else
            If Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 8) > numero Then
                numero = Mid(ARCHIVOS(x), 4, Len(ARCHIVOS(x)) - 8)
                ext = Right(ARCHIVOS(x), Len(ARCHIVOS(x)) - InStr(1, ARCHIVOS(x), ".") + 1)
            End If
        End If
    ElseIf tipo = "MNE" Then
        ListarFicherosCarpeta = ARCHIVOS(x)
    End If
Next x
If numero = 0 And ListarFicherosCarpeta = "" Then
    ListarFicherosCarpeta = ""
    Exit Function
End If
If tipo = "MX" Then
    ListarFicherosCarpeta = tipo & "_" & Mid(numero, 1, 8) & "_" & Mid(numero, 9, 6) & ext
ElseIf tipo = "MNE" Then
    ListarFicherosCarpeta = ListarFicherosCarpeta
ElseIf tipo = "LED" Then
 
    ListarFicherosCarpeta = tipo & numero & ext
End If
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Limpiamos los objetos y variables definidas

Set fso = Nothing
Set Carpeta = Nothing
Set Ficheros = Nothing
 
Application.ScreenUpdating = True
End Function
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
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

error macros

Publicado por Antoni Masana (2477 intervenciones) el 03/02/2016 09:25:22
Te contesto por cortesía pero ¿Que significa esto?

Podrías explicar que intentas hacer, que problema tienes, que error sale si sale uno, incluir la macro completa y el fichero Excel para probar, en fin molestarte un poquito más en la consulta.

Creo que si no te puedes molestar en dar un mínimo de explicación no esperes que alguien se tome la molestia de perder tiempo en intentar interpretar tu problema proque entre otras cosas tenemos nuestros propios problemas en nuestros trabajos.

Este correo no merece ni esta respuesta.
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

error macros

Publicado por pedro (3 intervenciones) el 03/02/2016 20:56:42
Estimado Antoni, sorry ya se lo que paso el editor del foro tiene unlimite de caracteres y al tratar de cortarlo elimine la explicacion fue sin querrer.

el problema es que tengo esta macros(copio el codigo) y ejecuto en equipos con xp y win 7 en ambos funciona y en ambos se cae la diferencia es que detecte que en win 7 se cae siempre en PC con 32 bit. no se si tiene que ver por alguna parte lei que el problema puede deberse a que por la edicion de windows algunos comando no los reconoce, tambien adjunto un archivo con pantallazo del error, si alguien pueda ayudar, muchas gracias'

texto del error es " se a producido error '5' en tiempo de ejecucion : argumento o llamada a procedimiento no valida"

en el codigo comente la linea donde muestra el error

saludos.
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

error macros

Publicado por agustin (149 intervenciones) el 03/02/2016 22:47:38
En que línea te da el error? No veo ningún comentario que lo indique.
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
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

error macros

Publicado por Antoni Masana (2477 intervenciones) el 04/02/2016 09:03:11
Aceptadas las disculpas y entendido el problema te comento es mejor que el código al ser tan largo lo incluyas como fichero adjunto.

Analizando el código

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Function Corta_Datos(lin As String, ori As String)
    Dim campos, y, u, marca As Integer
    marca = 1
    campos = 15
    If Right(lin, 1) <> ";" Then
       lin = lin & ";"
    End If
    y = UBound(OPES)
    OPES(y).origen = ori
    OPES(y).Cliente = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
    lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
    OPES(y).Rut_Orig = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "") //// AQUI MARCA ERROR      

    lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
    OPES(y).Rut_Ficticio = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
    ...

Encuentro a faltar el valor de SEP ¿Que es SEP? ¿Que contiene la variable lin en cada paso?

Una alternativa que utilizo y me da buenos resultados:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Function Corta_Datos(lin As String, ori As String)
    Dim campos, y, u, marca As Integer
    marca = 1
    campos = 15
    If Right(lin, 1) <> ";" Then
       lin = lin & ";"
    End If
    y = UBound(OPES)
    OPES(y).origen = ori
MsgBox "A - (" & lin & ")"
    OPES(y).Cliente   = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
    lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
MsgBox "B - (" & lin & ")"
    OPES(y).Rut_Orig = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
    lin = Mid(lin, InStr(1, lin, SEP) + 1, Len(lin) - InStr(1, lin, SEP) + 1)
MsgBox "C - (" & lin & ")"
    OPES(y).Rut_Ficticio = Replace(Mid(lin, 1, InStr(1, lin, SEP) - 1), """", "")
    ...

¿Con esto que se consigue? como vas modificando el valor de LIN puedes ver donde esta el fallo.

En el segundo MsgBox podrás ver que contiene la variable y por que da error

Saludos.
\\//_
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

error macros

Publicado por pedro (3 intervenciones) el 04/02/2016 15:01:34
Estimados agradezco su ayuda, pero resolvi el problema, efectivamente hay un problema con las versiones de los istemas operativos, les cuento quizas pueda que le sirva a alguien, la macros se creo en un win 7 de 64 bit al correr en cualquier maquina con 32 Bit los comandos de VBA tienes problemas de captura de datos por ejemplo el Comando MID al combinarce con el comando REPLACE y INSTR no aguanta parametro muy largos, tratare de poder un ejemplo un poco mas adelate, muchas gracias.
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