none
error 1004 en tiempo de ejecucion RRS feed

  • Pregunta

  • Buenas Amigos, tengo el siguiente problema, trabajando con visual basic (VBA) trae información por rango de fechas. si son hasta 6 meses funciona pero cuando mando traer 8 o mas.

    me pueden ayudar orientándome donde por donde va el error agrego el código y subrayo la parte en la que me marca error.

    Option Explicit
    Public CN As ADODB.Connection
    Public miServidor As String, miUsuario As String, miPass As String, miBDD As String, miEmpresa As String
    Public miHoja As Boolean, miDocum As Long
    Public Final1 As Integer
    Public miConta As Integer
    Public miAgente As Integer
    
    Dim Fila, Final As Long
    
    Private Sub Auto_Open()
        Hoja8.Select
        Call Arranque
    End Sub
    Public Sub Arranque()
        Dim SQL As String
        Dim Connected As Boolean
        Dim Resp As Long
        
        Hoja8.Select
        
        miServidor = Hoja6.Cells(6, 2).Value
        miUsuario = Hoja6.Cells(7, 2).Value
        miPass = Hoja6.Cells(8, 2).Value
        miHoja = True
    
        Connected = Connect(miServidor, miUsuario, miPass, "CompacWAdmin")
        If Connected Then '1
    
            Call Query_Empresas
            Call Disconnect
            
        Else
    
            Resp = MsgBox("Parametros Incorrectos!!!", vbCritical, "Error")
    
        End If
    
    End Sub
    Public Sub Principal()
        Dim SQL As String
        Dim Connected As Boolean
        Dim fIni As String, fFin As String
        Dim miAlmacen As Long
    
        
    
        Hoja6.Cells(9, 2).Calculate
        miEmpresa = Hoja6.Cells(5, 2).Value
        miServidor = Hoja6.Cells(6, 2).Value
        miUsuario = Hoja6.Cells(7, 2).Value
        miPass = Hoja6.Cells(8, 2).Value
        miBDD = Hoja6.Cells(9, 2).Value
    
        Connected = Connect(miServidor, miUsuario, miPass, miBDD)
         If Connected Then
    
            Call Query_Ejercicios
            Call Disconnect
    
        Else
    
            MsgBox "No podemos Conectarnos a Ejercicios!"
        End If
    
        Connected = Connect(miServidor, miUsuario, miPass, miBDD)
         If Connected Then
    
            Call Query_Almacenes
            Call Disconnect
    
        Else
    
            MsgBox "No podemos Conectarnos a Ejercicios!"
        End If
    
        
    
    '******** Documentos
        miEmpresa = Hoja6.Cells(5, 2).Value
        miServidor = Hoja6.Cells(6, 2).Value
        miUsuario = Hoja6.Cells(7, 2).Value
        miPass = Hoja6.Cells(8, 2).Value
        miBDD = Hoja6.Cells(9, 2).Value
        fIni = Hoja6.Range("B3").Value
        fFin = Hoja6.Range("B4").Value
    
        miHoja = True
        Connected = Connect(miServidor, miUsuario, miPass, miBDD)
        If Connected Then
    
            Call Query_Documentos
            Call Disconnect
            Final = Hoja1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row 'GetUltimoR(Hoja1)
            For miConta = 2 To Final
                Hoja9.Cells(miConta, 1) = Hoja1.Cells(miConta, 5)
            Next
            ActiveWorkbook.Names.Add Name:="misClientes", RefersTo:=Hoja9.Range("A2:A" & Final)
            Hoja9.Range("misClientes").RemoveDuplicates Columns:=1, Header:=xlNo
    
        Else
    
            MsgBox "No podemos Conectarnos a Documentos!"
        End If
    
        
    '******** Movimientos de Traspaso
        Hoja2.Cells.ClearContents
        
        Final1 = Hoja2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row + 1
        
        Connected = Connect(miServidor, miUsuario, miPass, miBDD)
        If Connected Then
    
            Call Query_Movimientos_Traspasos
            Call Disconnect
    
        Else
    
            MsgBox "No podemos Conectarnos a Movimientos!"
        End If
    
    '******** Relaciona los movimientos del almacen del Reporte (Movimientos Ocultos)
        Dim Ren1 As Long, Ren As Long
        Ren1 = 2
        miAlmacen = Hoja6.Cells(12, 2).Value
    
        Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        For Ren = 2 To Final1
            If Hoja2.Cells(Ren, 6).Value = miAlmacen Then
                If Hoja2.Cells(Ren, 10).Value = 0 Then
                    Do While Hoja2.Cells(Ren, 3).Value <> Hoja2.Cells(Ren1, 11).Value
                        Ren1 = Ren1 + 1
                    Loop
                    Hoja2.Cells(Ren, 14).Value = Hoja2.Cells(Ren1, 6).Value
                    Hoja2.Cells(Ren, 15).Value = Hoja2.Cells(Ren1, 5).Value
                    Ren1 = 1
                Else
                    Do While Hoja2.Cells(Ren, 11).Value <> Hoja2.Cells(Ren1, 3).Value
                        Ren1 = Ren1 + 1
                    Loop
                    Hoja2.Cells(Ren, 4).Value = Hoja2.Cells(Ren1, 4).Value
                    Hoja2.Cells(Ren, 14).Value = Hoja2.Cells(Ren1, 6).Value
                    Hoja2.Cells(Ren, 15).Value = Hoja2.Cells(Ren1, 5).Value
                    Ren1 = 1
                End If
            End If
        Next
    
    
    '******** Productos
        'Ultimo renglon de Productos
        Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        'Ciclo para los documentos
        For miConta = 2 To Final
            ' Toma el cid del procuto para buscar clave y nombre
            miDocum = Hoja2.Cells(miConta, 7).Value
    
            Connected = Connect(miServidor, miUsuario, miPass, miBDD)
            If Connected Then
    
                Call Query_Productos
                Call Disconnect
    
            Else
    
                MsgBox "No podemos Conectarnos a Productos!"
            End If
        Next
    
    '******** Sustituye el numero del Documento por el cidDocumento
        Final = Hoja1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        For miConta = 2 To Final
            For Ren1 = 2 To Final1
                If Hoja2.Cells(Ren1, 4).Value = Hoja1.Cells(miConta, 1).Value Then
                    Hoja2.Cells(Ren1, 1).Value = Hoja1.Cells(miConta, 4).Value
                    Hoja2.Cells(Ren1, 4).Value = Hoja1.Cells(miConta, 3).Value
                End If
            Next
        Next
    
    
    
    '******** Conceptos
        'Ultimo renglon de Productos
        Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        'Ciclo para los documentos
        For miConta = 2 To Final
            Hoja2.Cells(miConta, 2).Value = "Traspaso"
        Next
    
    
    '******** Busca el Nombre del Almacen del movimiento oculto
        Final = Hoja4.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        Final1 = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        For miConta = 3 To Final
            For Ren1 = 2 To Final1
                If Hoja2.Cells(Ren1, 14).Value = Hoja4.Cells(miConta, 3).Value Then
                    Hoja2.Cells(Ren1, 14).Value = Hoja4.Cells(miConta, 1).Value
                End If
            Next
        Next
    
    
    '******* Genera Reporte de Movimientos ********
        Dim Filas As Long, miConta2 As Long
        Dim miComision As Double, miFactAct As Long, miFactAnt As Long
        Dim Filas_Ini As Long, miTot_Gral As Long
    
        Hoja3.Select
        Hoja3.Range("A8:K2000").ClearContents
    
        Hoja3.Cells(8, 1).Value = "Almacén"
        Hoja3.Cells(9, 1).Value = "Nombre:"
        
        Filas = Hoja4.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    
        For miTot_Gral = 3 To Filas
            If Hoja4.Cells(miTot_Gral, 3).Value = Hoja6.Cells(12, 2).Value Then
                Hoja3.Cells(8, 2).Value = Hoja4.Cells(miTot_Gral, 1).Value
                Hoja3.Cells(9, 2).Value = Hoja4.Cells(miTot_Gral, 2).Value
            End If
        Next
        Hoja3.Cells(11, 1).Value = "'36        "
        Hoja3.Cells(11, 2).Value = "Traspasos"
        Hoja3.Cells(11, 3).Value = "Traspasos"
        
        Filas = 12
        
        For miTot_Gral = 1 To 13
            Hoja3.Cells(6, miTot_Gral).Font.Bold = True
            'Hoja3.Cells(6, miTot_Gral).HorizontalAlignment = xlCenter
        Next
        miTot_Gral = 0
        Hoja3.Cells(1, 6) = miEmpresa
        Hoja3.Cells(2, 11) = Day(Date) _
            & "/" & Application.VLookup(Month(Date), Range("Mes_corto"), 3, False) _
            & "/" & Year(Date)
        Hoja3.Cells(3, 1) = "Moneda: Peso Mexicano                                                               Del:  " & _
            Mid(fIni, 2, 10) & " al: " & Mid(fFin, 2, 10)
        'Total de Documentos Ultimo renglon de Documentos
        Final = Hoja2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row 'GetUltimoRm(Hoja2)
        'Ciclo para generar el reporte por Agente
        miAlmacen = Hoja6.Cells(12, 2).Value
        For miConta = 2 To Final
            If Hoja2.Cells(miConta, 14).Value <> "" Then
            ' Ciclo de los movimientos para generar el reporte
            Hoja3.Cells(Filas, 1) = Day(Hoja2.Cells(miConta, 1)) _
            & "/" & Application.VLookup(Month(Hoja2.Cells(miConta, 1)), Range("Mes_corto"), 3, False) _
            & "/" & Year(Hoja2.Cells(miConta, 1))
            Hoja3.Cells(Filas, 2) = Hoja2.Cells(miConta, 2)
            Hoja3.Cells(Filas, 3) = Hoja2.Cells(miConta, 14)
            Hoja3.Cells(Filas, 4) = Hoja2.Cells(miConta, 4)
            Hoja3.Cells(Filas, 6) = Hoja2.Cells(miConta, 7)
            Hoja3.Cells(Filas, 7) = Hoja2.Cells(miConta, 8)
            Hoja3.Cells(Filas, 8) = IIf(Hoja2.Cells(miConta, 15) = 1, 1, -1) * Hoja2.Cells(miConta, 9)
            Hoja3.Cells(Filas, 9) = 0
            Hoja3.Cells(Filas, 10) = IIf(Hoja2.Cells(miConta, 15) = 1, 1, -1) * Hoja2.Cells(miConta, 12)
            Hoja3.Cells(Filas, 11) = IIf(Hoja2.Cells(miConta, 15) = 1, "Entrada", "Salida")
            Filas = Filas + 1
            End If
        Next
        MsgBox "Reporte Generado!"
        Unload frmPrincipal
    
    
    End Sub
    
    


    viernes, 18 de enero de 2019 15:25

Todas las respuestas

  • Hola!

    sin saber cual es el error que te da (la descripción del error, el código por si solo no sirve de nada) no creo que podamos averiguar gran cosa.


    Saludos a todos desde Huelva Emilio http://www.mvp-access.es/emilio/

    domingo, 20 de enero de 2019 14:39
  • Hola

    Tal como comenta Emilio, sería interesante que nos dijeras el mensaje que te da. El error 1004 es un error "genérico", te puede dar con múltiples mensajes. Particularmente, a mi me ha vuelto loco copiando y pegando entre múltiples hojas de distintos libros. Más o menos lo solventé guardando cerrando y destruyendo los objetos de Worksheet y asignándolos nuevamente con un open.

    Independientemente, encontré ésto que creo puede ser de interés.

    Salu2,


    José Mª Fueyo

    • Propuesto como respuesta José Mª Fueyo viernes, 25 de enero de 2019 12:23
    martes, 22 de enero de 2019 8:11