Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - pandoro

#11
Hola el programa lo que hace es recoger cada linea de un data (recordset) y los va pegando en hojas de excel segun si en la hoja actual en tal celda existe un valor en concreto entonces lo pegas en esa hoja sino pasas a la siguiente hoja y sigues buscando, hasta el final de los registros...


consulta4 = "select * from lista where lista.[Réf Cde client]='IMP' and lista.[Exportado]=0;"
    Data5.RecordSource = consulta4
    Data5.Refresh
   
    If Data5.Recordset.RecordCount <> 0 Then
       
    'Crear fichero IMPx.xls
    Application.DisplayAlerts = False
   
    nombre = crear_ruta(2)
    nombre = nombre & "imp" & nficheroimp & ".xls"
   
    If Dir(nombre) = "" Then
   
        Application.Workbooks.Open App.Path & "\mdb\plantilla.xls"
        Application.Visible = False

        nombre = crear_ruta(2)
        nombre = nombre & "imp" & nficheroimp & ".xls"
        Application.ActiveWorkbook.SaveAs nombre
        Application.Quit
       
    Else
        'nada
    End If
   
        Application.Workbooks.Open nombre
        Application.Visible = False
       
        nhojas = Application.Worksheets.Count
        Application.ActiveWorkbook.Close
        Application.Quit
       
    Do While Not Data5.Recordset.EOF
        For cont = 0 To 6
            campos(cont) = Data5.Recordset.Fields(cont)
        Next
       
        'Buscar cliente y pegar datos
       
        For ihojas = 2 To nhojas 'empieza en 2 para saltarse la primera que es la plantilla
                       
            Application.Workbooks.Open nombre
            Application.Visible = False
           
            Application.Worksheets(ihojas).Activate
            nomhojas = Application.ActiveSheet.Name
            rangoB = "B"
           
            compara = Application.Worksheets(nomhojas).Cells(fila, rangoB).Value
            'compara = compara & "    "
           
            archivo = Split(compara, " ")
            archivo2 = Split(campos(1), " ")
           
            If archivo(0) = archivo2(0) Then
            'If compara = campos(1) Then
                rangoG = "G"
               
                If Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = "" Then

                    'Pegar datos
                    rangoA = "A"
                    Application.Worksheets(nomhojas).Cells(fila, rangoA).Value = campos(0)
                    Text1.Text = campos(0)
                    rangoB = "B"
                    Application.Worksheets(nomhojas).Cells(fila, rangoB).Value = campos(1)
                    Text2.Text = campos(1)
                    rangoC = "C"
                    Application.Worksheets(nomhojas).Cells(fila, rangoC).Value = campos(6)
                    Text7.Text = campos(6)
                    rangoD = "D"
                    Application.Worksheets(nomhojas).Cells(fila, rangoD).Value = campos(2)
                    Text3.Text = campos(2)
                    rangoE = "E"
                    Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)
                    Text4.Text = campos(3)
                    rangoF = "F"
                    Application.Worksheets(nomhojas).Cells(fila, rangoF).Value = "1"
                    Text5.Text = "1"
                    rangoG = "G"
                    Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(5)
                    Text6.Text = campos(5)
                    Text8.Text = "IMP"
                   
                    Data5.Recordset.Edit
                    Data5.Recordset.Fields(7) = 1
                   
                    Application.ActiveWorkbook.Save
                    Application.ActiveWorkbook.Close
                    Application.Quit
                   
                ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> "" Then
               
                    If Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(6) Then 'antes (6)
                        'Nada
                    ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> campos(6) Then
                   
                        fila = fila + 1
                        rangoG = "G" & fila & ""
                        Application.Range(rangoG).EntireRow.Insert
                        'Pegar datos
                        rangoA = "A"
                        Application.Worksheets(nomhojas).Cells(fila, rangoA).Value = campos(0)
                        Text1.Text = campos(0)
                        rangoB = "B"
                        Application.Worksheets(nomhojas).Cells(fila, rangoB).Value = campos(1)
                        Text2.Text = campos(1)
                        rangoC = "C"
                        Application.Worksheets(nomhojas).Cells(fila, rangoC).Value = campos(6)
                        Text7.Text = campos(6)
                        rangoD = "D"
                        Application.Worksheets(nomhojas).Cells(fila, rangoD).Value = campos(2)
                        Text3.Text = campos(2)
                        rangoE = "E"
                        Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)
                        Text4.Text = campos(3)
                        rangoF = "F"
                        Application.Worksheets(nomhojas).Cells(fila, rangoF).Value = "1"
                        Text5.Text = "1"
                        rangoG = "G"
                        Application.Worksheets(nomhojas).Cells(fila, rangoG).Value = campos(5)
                        Text6.Text = campos(5)
                        Text8.Text = "IMP"
                       
                        Data5.Recordset.Edit
                        Data5.Recordset.Fields(7) = 1
                        Data5.Recordset.Update
                       
                        Application.ActiveWorkbook.Save
                        Application.ActiveWorkbook.Close
                        Application.Quit
                       
                    End If
                   
                End If
               
            End If
           
        Next 'recorrer hojas del libro
       
        Data5.Recordset.MoveNext
    Loop
    'Guardar el fichero nuevo
    'Application.ActiveWorkbook.Save
    'Application.Quit
   
    Data5.Refresh
   
    Else
        nficheroimp = nficheroimp + 1
    End If


Me da error en la instruccion:

Application.Worksheets(nomhojas).Cells(fila, rangoE).Value = campos(3)

pero del ElseIf

ElseIf Application.Worksheets(nomhojas).Cells(fila, rangoG).Value <> "" Then

no el primero que hace...

pero no en la primera pasada sino cuando ya lleva varias hojas miradas y procesadas entonces me da el error.
#12
Hola colegas he realizado un programa en visual basic, pero en tiempo de ejecucion me da un error (el de la foto y no se que hacer porke no entiendo de que puede ser)
Espero que alguien me ayude , por favor.




un saludo
#13
Mi codigo es este:


Data1.Visible = True
DBGrid1.Visible = True
Dim contador2, cont As Integer
Dim code_client As String
Dim consulta, consulta2 As String

contador2 = 0
cont = 0

Data1.Connect = "Excel 8.0;"
Data3.Connect = "Excel 8.0;"
Data1.DatabaseName = App.Path & "\nuevo.xls"
Data3.DatabaseName = App.Path & "\nuevo.xls"

consulta = "select lista$.[Code client] from [lista$] group by lista$.[Code client]"

Data1.RecordSource = consulta
Data1.Refresh

Text2.Text = "Encontrados: " & Data1.Recordset.RecordCount & " registros."

Do While Not Data1.Recordset.EOF
code_client = Data1.Recordset.Fields(0)

    consulta2 = "SELECT lista$.[Code client], lista$.[N° colis CWF], Sum(lista$.[Qté livrée]) AS [SumaDeQté livrée], lista$.[Réf Cde client], lista$.[N° expédition CWF], lista$.[N° expédition CEPL] From [lista$] where lista$.[Code client]=""" & code_client & """ GROUP BY lista$.[Code client], lista$.[N° colis CWF], lista$.[Réf Cde client], lista$.[N° expédition CWF], lista$.[N° expédition CEPL]"

    Data3.RecordSource = consulta2
    Data3.Refresh
    Do While Not Data3.Recordset.EOF
        Form2.Show
        For cont = 0 To 5
            Form2.Text1(cont).Text = Data3.Recordset.Fields(cont)
        Next
        Data3.Recordset.MoveNext
    Loop
Data1.Recordset.MoveNext
Loop

Data1.Recordset.MoveFirst
Data3.Recordset.MoveFirst


Pero exactamente el mismo en access me funciona pero este en excel cuando llega a Data3.Refresh me da error y dice que " Pocos parámetros. Se esperaba 1."

alguien me puede ayudar???