Controlar error 462 |
Responder |
Autor | |
main
Colaborador Unido: 31/Agosto/2009 Localización: OVIEDO Estado: Sin conexión Puntos: 1258 |
Tema: Controlar error 462 Enviado: 21/Agosto/2019 a las 11:29 |
Access_2010 vs Windows_7 Buenos dias al grupo: Estoy creando un libro de excel a partir de una plantilla con el siguiente codigo: Private Sub BtnPedido_Click() Dim x As Long, y As Long, Arti As String, UltiFila As Long, LinPedido As Long, NumPre As Long Dim fila As Integer, columna As Integer, PreMin As Double, PreMax As Double, strFileName As String Dim xl As Excel.Application 'On Error GoTo Err_Open Set xl = Excel.Application xl.Workbooks.Open PatClien() & "\Plantillas\Pedido_ClientePVP2.xlsx" UltiFila = xl.Sheets(1).UsedRange.Rows.count fila = 23: columna = 1 LinPedido = (UltiFila - fila) / 2 ------------------------------------------------------------------- Aqui el resto del codigo para terminar ------------------------------------------------------------------ With xl.FileDialog(msoFileDialogSaveAs) .ButtonName = "Guardar" .InitialFileName = PatClien() & "\Pedido_" & Replace(Nz(Me.NameColec, "Catálogo"), Space(1), "_") .Title = "Guardar Libro Excel como" If .Show = -1 Then strFileName = .SelectedItems(1) Else MsgBox "Operación cancelada.", vbInformation, "PEDIDOS" xl.ActiveWorkbook.Close False GoTo Exit_ErrOpen End If End With xl.ActiveWorkbook.SaveAs strFileName xl.ActiveWorkbook.Close True MsgBox "Hoja de Pedido creada.", vbInformation, "PEDIDOS" Exit_ErrOpen: xl.Workbooks.Close xl.Application.Quit Set xl = Nothing Exit Sub Err_Open: If Err = 462 Then MsgBox "Error " & Err & vbCrLf & Err.description & vbCrLf & "Vuelve a intentarlo a continuación.", vbInformation, "PEDIDOS" Else MsgBox "Error " & Err & vbCrLf & Err.description End If End Sub El problema, al menos en mi ordenador porque en otros no lo he detectado, es que cuando ejecuto por segunda vez consecutiva el procedimiento, sin salirme del formulario, me salta el error 462 en tiempo de ejecucción. "El equipo servidor remoto no existe o no está disponible". Y esto se repite de forma continuada cuando habilito el control de errores. Si por el contrario lo deshabilito, funciona una Si y otra NO correlativamente. ¿Como puedo controlarlo? Saludos para todos. Editado por main - 21/Agosto/2019 a las 11:31 |
|
jilo
Ver perfil usuario
Enviar mensaje privado
Ver los mensajes del usuario
Visite la página de los usuarios
Añadir a la lista de amigos
Colaborador Unido: 19/Diciembre/2004 Localización: TAFALLA Estado: Sin conexión Puntos: 959 |
Enviado: 22/Agosto/2019 a las 10:13 |
Hola Main, En que linea te salta el error??? |
|
Espero te sirva !!!!!!
Iñaki |
|
main
Colaborador Unido: 31/Agosto/2009 Localización: OVIEDO Estado: Sin conexión Puntos: 1258 |
Enviado: 22/Agosto/2019 a las 13:49 |
Hola Jilo: Pongo todo el codigo para que se vea completo Private Sub BtnPedido_Click() Dim x As Long, y As Long, Arti As String, UltiFila As Long, LinPedido As Long, NumPre As Long Dim fila As Integer, columna As Integer, PreMin As Double, PreMax As Double, strFileName Dim xl As Excel.Application If Nz(Me.PatFoto, "") = "" Then MsgBox "Seleciona una carpeta con el catálogo.", vbInformation, "PEDIDOS": Exit Sub 'On Error GoTo Err_Open ' Creo una instancia de Excel 'Set xl = Excel.Application Aqui es donde saltaba primero el error y lo cambie por la siguiente linea Set xl = New Excel.Application xl.Workbooks.Open PatClien() & "\Plantillas\Pedido_ClientePVP2.xlsx" xl.ActiveSheet.UnProtect "******" UltiFila = xl.Sheets(1).UsedRange.Rows.count fila = 23: columna = 1 LinPedido = (UltiFila - fila) / 2 If LinPedido < Me.LstArti.ListCount Then If MsgBox("La plantila solo dispone de " & LinPedido & " Lineas de Pedido." & vbCrLf & "¿Deseas continuar.?", 292, "Pedidos") = vbNo Then xl.ActiveWorkbook.Close False GoTo Exit_ErrOpen End If End If For x = 0 To Me.LstArti.ListCount - 1 If LinPedido = 0 Then Exit For Arti = FicheroLogo(Nz(Me.PatFoto, PatClien()), Me.LstArti.ItemData(x)) If Arti <> "No Existe." Then xl.Cells(fila, columna).Activate ' .Select Me.LstArti = Me.LstArti.ItemData(x) LstArti_AfterUpdate xl.ActiveSheet.Shapes.AddPicture Me.PatFoto & "\" & Arti, False, True, xl.ActiveCell.Left, xl.ActiveCell.Top, xl.ActiveCell.Width, xl.ActiveCell.Height * 2 xl.Range("A20") = Me.NameColec xl.Cells(fila, columna + 1) = Me.LstArti.Column(2): xl.Cells(fila, columna + 2) = Me.LstArti: xl.Cells(fila, columna + 3) = Me.LstArti.Column(3) If Me.LstPVPArti.ListCount = 1 Then xl.DisplayAlerts = False xl.Cells(fila, 33) = Me.LstPVPArti.Column(1) For y = 31 To 34 'Combino las celdas de las columnas de los artículos que tienen un solo precio xl.Range(Cells(fila, y), Cells(fila + 1, y)).Merge 'Ahora me salta aqui Next y xl.DisplayAlerts = True For y = 0 To Me.LstTalla.ListCount - 1 'Combino las celdas de las columnas de tallas de los artículos que tienen un solo precio xl.Range(Cells(fila, Me.LstTalla.Column(1, y) - 11), Cells(fila + 1, Me.LstTalla.Column(1, y) - 11)).Merge xl.Range(Cells(fila, Me.LstTalla.Column(1, y) - 11), Cells(fila + 1, Me.LstTalla.Column(1, y) - 11)).Interior.Color = RGB(255, 255, 255) xl.Range(Cells(fila, Me.LstTalla.Column(1, y) - 11), Cells(fila + 1, Me.LstTalla.Column(1, y) - 11)).BorderAround LineStyle:=xlContinuous, ColorIndex:=0 ', Weight:=xlThick Next y Else PreMin = DMin("PVP", "ArticulosEmpresa", "ReferArti='" & Me.LstArti & "'") PreMax = DMax("PVP", "ArticulosEmpresa", "ReferArti='" & Me.LstArti & "'") xl.Cells(fila, 33) = CDbl(PreMin) xl.Cells(fila + 1, 33) = CDbl(PreMax) For y = 0 To Me.LstTalla.ListCount - 1 'Resalto las celdas de las columnas de tallas de los artículos que tienen dos precios If Me.LstTalla.Column(2, y) = PreMin Then xl.Cells(fila, Me.LstTalla.Column(1, y) - 11).BorderAround LineStyle:=1, Weight:=xlThin, ColorIndex:=0 xl.Cells(fila, Me.LstTalla.Column(1, y) - 11).Interior.Color = RGB(255, 255, 255) Else xl.Cells(fila + 1, Me.LstTalla.Column(1, y) - 11).BorderAround LineStyle:=1, Weight:=xlThin, Color:=RGB(0, 0, 0) xl.Cells(fila + 1, Me.LstTalla.Column(1, y) - 11).Interior.Color = RGB(255, 255, 255) End If Next y End If NumPre = Me.LstPVPArti.ListCount fila = fila + 2 LinPedido = LinPedido - 1 End If Next x strFileName = xl.GetSaveAsFilename( _ InitialFileName:=PatClien() & "\Pedido_" & Replace(Nz(Me.NameColec, "Catálogo"), Space(1), "_"), _ fileFilter:="Archivos Excel (*.xlsx), *.xlsx") If strFileName = False Then MsgBox "Operación cancelada.", vbInformation, "PEDIDOS" xl.ActiveWorkbook.Close False GoTo Exit_ErrOpen End If 'xl.ActiveSheet.ScrollArea = "E2:AD126" 'xl.Cells(23, 2).Locked = True xl.ActiveSheet.Protect "******" xl.ActiveWorkbook.SaveAs strFileName xl.ActiveWorkbook.Close True MsgBox "Hoja de Pedido creada.", vbInformation, "PEDIDOS" Exit_ErrOpen: xl.Workbooks.Close xl.Application.Quit Set xl = Nothing exit sub Err_Open: If Err = 462 Then MsgBox "Error " & Err & vbCrLf & Err.description & vbCrLf & "Vuelve a intentarlo a continuación.", vbInformation, "PEDIDOS" Set xl = New Excel.Application Resume Exit_ErrOpen ElseIf Err = 1004 Then xl.ActiveWorkbook.Close False Resume Exit_ErrOpen Else MsgBox "Error " & Err & vbCrLf & Err.description End If End Sub Es como si tuviera abierta la aplicación de excel y no me lacerrara al terminar el procedimiento.
Editado por main - 22/Agosto/2019 a las 14:27 |
|
pitxiku
Colaborador Unido: 27/Septiembre/2017 Localización: En mi casa Estado: Sin conexión Puntos: 1512 |
Enviado: 22/Agosto/2019 a las 16:17 |
A ver si esto te sirve: - https://support.microsoft.com/es-es/help/189618/you-may-receive-the-run-time-error-2147023174-800706ba-error-message-o Que en tu caso, puede ser porque Cells no es de Access y no está referenciado al objeto Excel que has abierto:
|
|
main
Colaborador Unido: 31/Agosto/2009 Localización: OVIEDO Estado: Sin conexión Puntos: 1258 |
Enviado: 23/Agosto/2019 a las 11:12 |
Hola: Reuelto, efectivamente cells no es de Access y no está referenciado al objeto Excel que tengo abierto: xl.Range(xl.Cells(fila, y), xl.Cells(fila + 1, y)).Merge |
|
Responder | |
Tweet
|
Ir al foro | Permisos de foro Usted No puede publicar nuevos temas en este foro Usted No puede responder a temas en este foro Usted No puede borrar sus mensajes en este foro Usted No puede editar sus mensajes en este foro Usted No puede crear encuestas en este foro Usted No puede votar en encuestas en este foro |