Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » ERROR AL CORRER MACRO EXCEL

Visual Basic - ERROR AL CORRER MACRO EXCEL

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

ERROR AL CORRER MACRO EXCEL

Publicado por Pedro (4 intervenciones) el 27/02/2024 19:19:46
Buenos días, tengo un tema con este código.
La macro hace prácticamente lo que le pido, todo esta bien, pero de repente una persona me dijo que se le trabó en el proceso. No mandó un error, solo se quedó en blanco la pantalla.
solo hizo un registro y de datos (esta hecho para 200 registros) y no tenia muchos programas abiertos, solo el correo, dos exceles y el explorador de archivos.
¿Me pueden ayudar a ver si es tema del código o es tema de la computadora?
En el mío compila bien.
Tengo una máquina con i5 (excel 2019)
Donde se corrió el programa es una i13. (excel 2013)
Comparto macro y archivo.

Ojalá me puedan ayudar.


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
Sub AltaLayoutInbursa()
    Dim numFilas As Long
    Dim FilePath As String
    Dim copyRange As Range
    Dim destinationSheet As Worksheet
    Dim cargaSheet As Worksheet
    Dim cell As Range
 
    ' Obtener el número de filas a copiar desde A2 hasta H en la hoja "INTERBANCARIOS"
    numFilas = Sheets("INTERBANCARIOS").Range("E1").Value
 
    ' Definir la hoja de "CARGA"
    Set cargaSheet = ThisWorkbook.Sheets("CARGA")
    ' Copiar formato de las columnas P1:S1 en la hoja "CARGA"
    Sheets("CARGA").Range("P1:S1").Copy
    cargaSheet.Range("A7:D" & cargaSheet.Cells(cargaSheet.Rows.Count, "A").End(xlUp).Row).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False ' Limpiar el portapapeles
 
    ' Definir los rangos a copiar
    Set destinationSheet = Sheets.Add
 
 
    ' Copiar A2:C[numFilas+1] en la misma hoja
    Sheets("INTERBANCARIOS").Range("A1:C" & numFilas + 1).Copy destinationSheet.Range("A1")
 
    ' Aplicar RemoveTrash solo a la hoja "CARGA"
    For Each cell In cargaSheet.Range("A7:D213")
        cell.Value = RemoveTrash(cell.Value)
    Next cell
 
    ' Establecer la ruta y nombre de archivo para guardar
    FilePath = Application.GetSaveAsFilename(FileFilter:="Archivos de texto (*.txt), *.txt", Title:="Guardar como archivo de texto")
    If FilePath <> "False" Then
        ' Guardar el contenido de la hoja de destino como un archivo de texto
        Open FilePath For Output As #1
 
        Dim fila As Long, col As Long
        For fila = 1 To destinationSheet.UsedRange.Rows.Count
            Dim texto As String
            texto = ""
 
            For col = 1 To destinationSheet.UsedRange.Columns.Count
                If col > 1 Then
                    If destinationSheet.Cells(fila, col) <> "" Then
                        texto = texto & vbTab ' Usar tabulación como separador
                    End If
                End If
 
                ' Verificar si el valor es numérico
                If IsNumeric(destinationSheet.Cells(fila, col).Value) Then
                    ' Agregar el valor con formato original
                    texto = texto & destinationSheet.Cells(fila, col).Text
                Else
                    texto = texto & destinationSheet.Cells(fila, col).Value
                End If
 
            Next col
 
            If Len(Trim(texto)) > 0 Then
                Print #1, texto
            End If
        Next fila
 
        Close #1
 
        ' Abre el Bloc de notas
        Shell "notepad.exe " & FilePath, vbNormalFocus
 
        ' Espera un momento para asegurarte de que el Bloc de notas esté abierto
        Application.Wait (Now + TimeValue("00:00:01"))
 
        ' Envía la combinación de teclas Ctrl + Fin al Bloc de notas
        Application.SendKeys "^{END}"
 
        Application.Wait (Now + TimeValue("00:00:01"))
 
        ' Envía la combinación de teclas Ctrl + Fin al Bloc de notas
        Application.SendKeys "{BS}"
 
        ' Cierra el Bloc de notas
        AppActivate "Bloc de notas"
        Application.SendKeys "^{G}"
        Application.SendKeys "%{F4}"
 
        Application.DisplayAlerts = False
        destinationSheet.Delete
        Application.DisplayAlerts = True
 
        ThisWorkbook.Save
    Else
        MsgBox "Operación cancelada."
        Application.DisplayAlerts = False
        destinationSheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub
 
Function RemoveTrash(Text)
    Const COMPSTR = "áéíóúÁÉÍÓÚ.ñÑ!#$%&/()='?¿¡,:"
    Const REPLSTR = "aeiouAEIOU nN               "
    Dim Pos, Iter
 
    For Iter = 1 To Len(Text)
        Pos = InStr(1, COMPSTR, Mid(Text, Iter, 1))
        If Pos <> 0 Then
            Mid(Text, Iter, 1) = Mid(REPLSTR, Pos, 1)
        End If
    Next
 
    RemoveTrash = Text
End Function

comparto el código y el archivo.

La contraseña es "1"
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: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

ERROR AL CORRER MACRO EXCEL

Publicado por Antoni Masana (566 intervenciones) el 28/02/2024 17:16:26
De entrada no veo nada que pueda estar mal.
Falta el archivo para probar la macro y ver que hace.
A parte de probarlo se me ocurre una par de alternativas para detectar el error.

1.- Poner DoEvents en varias partes del proceso, sobre todo en los bucles.
2.- Crear un LOG.

Te preguntaras que es esto: Esto es simplemente abrir un fichero de texto al inicio de la macro que tenga por nombre la fecha y la hora.
Nombre de ejemplo: 2024.02.28-16.56.log

He ir poniendo escrituras en diferentes partes de la macro. Ejemplo;

1
2
3
4
Print #99, "01 - Copia CARGA - P1:S1"
    Sheets("CARGA").Range("P1:S1").Copy
Print #99, "02 - Pega hoja CARGA - A7:D" &  & cargaSheet.Cells(cargaSheet.Rows.Count, "A").End(xlUp).Row
    cargaSheet.Range("A7:D" & cargaSheet.Cells(cargaSheet.Rows.Count, "A").End(xlUp).Row).PasteSpecial xlPasteFormats

Al final de la macro cerrar el fichero:

La próxima vez analizando el LOG se vera donde se encalla.

NOTA: Guarda una copia de la macro antes de añadir toda esta cochinada de código, será más fácil de restaurar.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar