Al convertir excel a EXE me deja de funcionar 1 solo código..
Tengo una archivo .xlsm que funcionan los códigos perfectamente... El detalle es que al convertirlo a .EXE (ejecutable) me deja de funcionar el siguiente código:
Le doy depurar, Solo eso me sale, le quito esa línea y el traspaso de datos no procede... Por favor ayudenme, Estoy estresado no he podido con este código...:C Reitero... Sin convertirlo a .EXE funciona de maravilla, pero al realizar la conversión empieza el problema y es importante convertirlo ya que se manejan varios libros...
2 respuestas
Respuesta de jairo retorno
1
Este es el código que utilizo
Sub importar_usuarios()
elimina = MsgBox("Al Finalizar De Importar Los Datos" & vbCr & "El Archivo Se Eliminará Por Seguridad." & vbCr & _
"¿Deseas Continuar?", vbExclamation + vbYesNo, "IMPORTAR DATOS")
If elimina = vbNo Then Exit Sub
''On Error GoTo libro
Application.ScreenUpdating = False
Application.EnableEvents = False
DisplayAlerts = False
Dim fil, uf As Integer
Dim path As Variant
Dim mybook As String
uf = Sheets("DATOS").Range("G" & Rows.Count).End(xlUp).Row
fila = uf + 1
'Encuentra el nombre del archivo
'ChDir "c:\temp\desktop"
path = Application.GetOpenFilename(FileFilter:="Busca Archivo DinDin (*.xlsx *), *.xlsx*", _
Title:="Seleccione un archivo de Excel")
'si hemos seleccionado algún archivo muestra un cuadro mensaje
If path = False Then
Exit Sub
End If
Sheets("DATOS").Range("a41") = path ''''''aqui va lo que necesitabmos saber
FullName = Split(path, Application.PathSeparator)
Sheets("DATOS").Range("a42") = FullName ''''''aqui va lo que necesitabmos saber
mybook = FullName(UBound(FullName))
Sheets("DATOS").Range("a43") = mybook ''''''aqui va lo que necesitabmos saber
sele = MsgBox("Seleccionaste el archivo:" & vbCr & vbCr & _
UCase(path), vbQuestion + vbYesNo, "")
If sele = vbNo Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open Filename:=mybook, UpdateLinks:=0
a = Sheets("DATOS").Range("A1:E18500")
'Workbooks(mybook).Close SaveChanges:=True
Workbooks(mybook).Close
'****************************************************************
Sheets("DATOS").Range("A1:E18500") = a
'****************************************************************
DisplayAlerts = True
MsgBox "Se Ha Eliminado el Libro: " & FullName(UBound(FullName)) & vbCr _
& ", Para Otra Actualización Solicitelo A su Jefe Inmediato.", vbInformation, "Cambios Realizados con Exito"
Application.ScreenUpdating = True
Exit Sub
libro:
MsgBox "Sin Selección de Archivo." & vbCr & Err.Description, vbCritical, "ERROR"
Workbooks(mybook).Close SaveChanges:=True
End Sub
Respuesta de Dante Amor
1
Dice
Se producido el error "9" en tiempo de ejecución
Sud índice fuera de intervalo
Espero me puedas ayudar dan... Te agradezco saludos
Esto es lo que encontré:
Prueba esto:
Sub importar_usuarios()
'elimina = MsgBox("Al Finalizar De Importar Los Datos" & vbCr & "El Archivo Se Eliminará Por Seguridad." & vbCr & _
"¿Deseas Continuar?", vbExclamation + vbYesNo, "IMPORTAR DATOS")
'If elimina = vbNo Then Exit Sub
''On Error GoTo libro
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
'
Dim fil, uf As Integer, fila, FullName, sele, a
Dim path As Variant
Dim mybook As String
'
uf = Sheets("DATOS").Range("G" & Rows.Count).End(xlUp).Row
fila = uf + 1
'Encuentra el nombre del archivo
'ChDir "c:\temp\desktop"
path = Application.GetOpenFilename(FileFilter:="Busca Archivo DinDin (*.xlsx *), *.xlsx*", _
Title:="Seleccione un archivo de Excel")
'si hemos seleccionado algún archivo muestra un cuadro mensaje
If path = False Then
Exit Sub
End If
'
Sheets("DATOS").Range("a41") = path ''''''aqui va lo que necesitabmos saber
FullName = Split(path, Application.PathSeparator)
Sheets("DATOS").Range("a42") = FullName ''''''aqui va lo que necesitabmos saber
mybook = FullName(UBound(FullName))
Sheets("DATOS").Range("a43") = mybook ''''''aqui va lo que necesitabmos saber
'sele = MsgBox("Seleccionaste el archivo:" & vbCr & vbCr & _
UCase(path), vbQuestion + vbYesNo, "")
'If sele = vbNo Then Exit Sub
'
Workbooks.Open Filename:=path, UpdateLinks:=0
a = Sheets("DATOS").Range("A1:E18500")
'Workbooks(mybook).Close SaveChanges:=True
Workbooks(mybook).Close
'****************************************************************
Sheets("DATOS").Range("A1:E18500") = a
'****************************************************************
'
Application.DisplayAlerts = True
MsgBox "Se Ha Eliminado el Libro: " & FullName(UBound(FullName)) & vbCr _
& ", Para Otra Actualización Solicitelo A su Jefe Inmediato.", vbInformation, "Cambios Realizados con Exito"
Application.ScreenUpdating = True
Exit Sub
'
libro:
MsgBox "Sin Selección de Archivo." & vbCr & Err.Description, vbCritical, "ERROR"
Workbooks(mybook).Close SaveChanges:=True
End Sub