HOLA ESPERO QUE ALGINE ME pueda ayudar el caso es que estoy realizando una
aplicacion que genera reportes a excel desde una base de datos mediante
codigo y en xp funciona bien pero al momento de pasarlo a 98 marca error
de automatizacion el codigo es el siguiente.
Dim i As Integer
Dim J As Integer
Dim ApExcel As Object
Dim objLibro As Object
Dim s As Integer
Dim arch
Dim sec As Integer
Dim sec1 As Integer
Dim NOMS As String
Dim CVL As Integer
Dim rngCurrent
Dim BTR, net, PAG As Double 'sem4
Dim BTR3, NET3, PAG3 As Double 'sem3
Dim BTR2, NET2, PAG2 As Double 'sem2
Dim BTR1, NET1, PAG1 As Double 'sem1
Dim con As Double
sec1 = 0
Dim inter As Integer
Mdi_Frm_Incentivos.CommonDialog1.Filter = "Libro de Microsoft Excel|*.xls"
Mdi_Frm_Incentivos.CommonDialog1.ShowSave
arch = Mdi_Frm_Incentivos.CommonDialog1.FileName
If arch = "" Then 'errorororo
MsgBox "No se genero el Reporte", vbCritical
Exit Sub
Else
Mdi_Frm_Incentivos.MousePointer = 11
Set ApExcel = CreateObject("Excel.application")
'añadimos un hoja nueva
ApExcel.Workbooks.Add 'aqui da error
i = 1
J = 2
s = SEM
sec1 = 0
con = 0
Set rngCurrent = ApExcel.Worksheets(1).Range("A1", "A6000")
rngCurrent.ColumnWidth = 5
rngCurrent.Cells.Font.Size = 8
Set rngCurrent = ApExcel.Worksheets(1).Range("A1", "A6000")
rngCurrent.ColumnWidth = 3
Set rngCurrent = ApExcel.Worksheets(1).Range("B1", "B6000")
rngCurrent.Cells.Font.Size = 8
Set rngCurrent = ApExcel.Worksheets(1).Range("B1", "B6000")
rngCurrent.ColumnWidth = 28
Set rngCurrent = ApExcel.Worksheets(1).Range("C1", "Q6000")
rngCurrent.Cells.Font.Size = 8
Set rngCurrent = ApExcel.Worksheets(1).Range("C1", "Q6000")
rngCurrent.ColumnWidth = 3
conex
RST_SECCION.Source = " SELECT * FROM TB_SECCIONES"
RST_SECCION.ActiveConnection = ADOCONN
RST_SECCION.Open
While Not RST_SECCION.EOF
sec = RST_SECCION.Fields("CVL_SECCION")
NOMS = RST_SECCION.Fields("DESCRIPCION")
If sec = sec1 Then
ApExcel.Cells(i, 8).Value = NOMS 'aqui da error
Else
con = 0
sec1 = RST_SECCION.Fields("CVL_SECCION")
ApExcel.Cells(i, 7).Value = "INDUSTRIAS HABERŽS, S.A. DE
C.V."
ApExcel.Cells(i + 1, 8).Value = NOMS
ApExcel.Cells(i + 2, 3).Value = "SEMANA " & (SEM - 3)
ApExcel.Cells(i + 2, 6).Value = "SEMANA " & (SEM - 2)
ApExcel.Cells(i + 2, 9).Value = "SEMANA " & (SEM - 1)
ApExcel.Cells(i + 2, 12).Value = "SEMANA " & (SEM)
ApExcel.Cells(i + 3, 3).Value = "EFI"
ApExcel.Cells(i + 3, 4).Value = "EFI"
ApExcel.Cells(i + 3, 5).Value = "EFI"
ApExcel.Cells(i + 3, 6).Value = "EFI"
ApExcel.Cells(i + 3, 7).Value = "EFI"
ApExcel.Cells(i + 3, 8).Value = "EFI"
ApExcel.Cells(i + 3, 9).Value = "EFI"
ApExcel.Cells(i + 3, 10).Value = "EFI"
ApExcel.Cells(i + 3, 11).Value = "EFI"
ApExcel.Cells(i + 3, 12).Value = "EFI"
ApExcel.Cells(i + 3, 13).Value = "EFI"
ApExcel.Cells(i + 3, 14).Value = "EFI"
ApExcel.Cells(i + 3, 15).Value = "PROMEDIO"
ApExcel.Cells(i + 3, 1).Value = "NUM"
ApExcel.Cells(i + 3, 2).Value = "NOMBRE COMPLETO"
ApExcel.Cells(i + 4, 3).Value = "BTR"
ApExcel.Cells(i + 4, 4).Value = "NET"
ApExcel.Cells(i + 4, 5).Value = "PAG"
ApExcel.Cells(i + 4, 6).Value = "BTR"
ApExcel.Cells(i + 4, 7).Value = "NET"
ApExcel.Cells(i + 4, 8).Value = "PAG"
ApExcel.Cells(i + 4, 9).Value = "BTR"
ApExcel.Cells(i + 4, 10).Value = "NET"
ApExcel.Cells(i + 4, 11).Value = "PAG"
ApExcel.Cells(i + 4, 12).Value = "BTR"
ApExcel.Cells(i + 4, 13).Value = "NET"
ApExcel.Cells(i + 4, 14).Value = "PAG"
ApExcel.Cells(i + 4, 15).Value = "BTR"
ApExcel.Cells(i + 4, 16).Value = "NET"
ApExcel.Cells(i + 4, 17).Value = "PAG"
End If
i = i + 5
RST_EMPLEADO.Source = " SELECT * FROM TB_EMPLEADO WHERE
CVL_SECCION=" & sec & " "
RST_EMPLEADO.ActiveConnection = ADOCONN
RST_EMPLEADO.Open
While Not RST_EMPLEADO.EOF
CVL = RST_EMPLEADO.Fields("CVL_EMPLEADO")
ApExcel.Cells(i, 1).Value = CVL
ApExcel.Cells(i, 2).Value RST_EMPLEADO.Fields("nombre_completo")
' 'eficiencias por semana btr,net,pag
RST_OPERIN3.Source = " SELECT * FROM TB_EMPSEM Where
(TB_EMPSEM.CVL_SEM = " & (SEM - 3) & ") AND CVL_EMPLEADO=" & CVL & ""
RST_OPERIN3.ActiveConnection = ADOCONN
RST_OPERIN3.Open
If Not RST_OPERIN3.EOF Then
ApExcel.Cells(i, J + 1).Value = RST_OPERIN3.Fields("efi_bru")
ApExcel.Cells(i, J + 2).Value = RST_OPERIN3.Fields("efi_net")
ApExcel.Cells(i, J + 3).Value = RST_OPERIN3.Fields("efi_pag")
BTR1 = BTR1 + RST_OPERIN3.Fields("efi_BRU")
NET1 = NET1 + RST_OPERIN3.Fields("efi_NET")
PAG1 = PAG1 + RST_OPERIN3.Fields("efi_pag")
End If
RST_OPERIN4.Source = " SELECT * FROM TB_EMPSEM Where
(TB_EMPSEM.CVL_SEM = " & (SEM - 2) & ") AND CVL_EMPLEADO=" & CVL & ""
RST_OPERIN4.ActiveConnection = ADOCONN
RST_OPERIN4.Open
If Not RST_OPERIN4.EOF Then
ApExcel.Cells(i, J + 4).Value = RST_OPERIN4.Fields("efi_bru")
ApExcel.Cells(i, J + 5).Value = RST_OPERIN4.Fields("efi_net")
ApExcel.Cells(i, J + 6).Value = RST_OPERIN4.Fields("efi_pag")
BTR2 = BTR2 + RST_OPERIN4.Fields("efi_BRU")
NET2 = NET2 + RST_OPERIN4.Fields("efi_NET")
PAG2 = PAG2 + RST_OPERIN4.Fields("efi_pag")
End If
RST_OPERIN5.Source = " SELECT * FROM TB_EMPSEM Where
(TB_EMPSEM.CVL_SEM = " & (SEM - 1) & ") AND CVL_EMPLEADO=" & CVL & ""
RST_OPERIN5.ActiveConnection = ADOCONN
RST_OPERIN5.Open
If Not RST_OPERIN5.EOF Then
ApExcel.Cells(i, J + 7).Value = RST_OPERIN5.Fields("efi_bru")
ApExcel.Cells(i, J + 8).Value = RST_OPERIN5.Fields("efi_net")
ApExcel.Cells(i, J + 9).Value = RST_OPERIN5.Fields("efi_pag")
BTR3 = BTR3 + RST_OPERIN5.Fields("efi_BRU")
NET3 = NET3 + RST_OPERIN5.Fields("efi_NET")
PAG3 = PAG3 + RST_OPERIN5.Fields("efi_pag")
End If
RST_OPERIN6.Source = " SELECT * FROM TB_EMPSEM Where
(TB_EMPSEM.CVL_SEM = " & (SEM) & ") AND CVL_EMPLEADO=" & CVL & ""
RST_OPERIN6.ActiveConnection = ADOCONN
RST_OPERIN6.Open
If Not RST_OPERIN6.EOF Then
' ApExcel.Cells(i, J).Value = RST_OPERIN6.Fields("cvl_empleado")
ApExcel.Cells(i, J + 10).Value = RST_OPERIN6.Fields("efi_bru")
ApExcel.Cells(i, J + 11).Value = RST_OPERIN6.Fields("efi_net")
ApExcel.Cells(i, J + 12).Value = RST_OPERIN6.Fields("efi_pag")
BTR = BTR + RST_OPERIN6.Fields("efi_BRU")
net = net + RST_OPERIN6.Fields("efi_NET")
PAG = PAG + RST_OPERIN6.Fields("efi_pag")
End If
ApExcel.Cells(i, 15).Value = (ApExcel.Cells(i, 3) +
(ApExcel.Cells(i, 6) + (ApExcel.Cells(i, 9) + (ApExcel.Cells(i, 12)))))
ApExcel.Cells(i, 16).Value = (ApExcel.Cells(i, 4) +
(ApExcel.Cells(i, 7) + (ApExcel.Cells(i, 10) + (ApExcel.Cells(i, 13)))))
ApExcel.Cells(i, 17).Value = (ApExcel.Cells(i, 5) +
(ApExcel.Cells(i, 8) + (ApExcel.Cells(i, 11) + (ApExcel.Cells(i, 14)))))
RST_OPERIN3.Close
RST_OPERIN4.Close
RST_OPERIN5.Close
RST_OPERIN6.Close
i = i + 1
con = con + 1
RST_EMPLEADO.MoveNext
Wend
If con = 0 Then
Else
ApExcel.Cells(i, 1).Value = "EFICIENCIA PROMEDIO DE LA SECCION =>"
ApExcel.Cells(i, 3).Value = BTR1 / con 'sem1
ApExcel.Cells(i, 4).Value = NET1 / con
ApExcel.Cells(i, 5).Value = PAG1 / con
ApExcel.Cells(i, 6).Value = BTR2 / con 'sem2
ApExcel.Cells(i, 7).Value = NET2 / con
ApExcel.Cells(i, 8).Value = PAG2 / con
ApExcel.Cells(i, 9).Value = BTR3 / con 'sem3
ApExcel.Cells(i, 10).Value = NET3 / con
ApExcel.Cells(i, 11).Value = PAG3 / con
ApExcel.Cells(i, 12).Value = BTR / con 'sem4
ApExcel.Cells(i, 13).Value = net / con
ApExcel.Cells(i, 14).Value = PAG / con
ApExcel.Cells(i, 15).Value = (ApExcel.Cells(i, 3) + (ApExcel.Cells(i,
6) + (ApExcel.Cells(i, 9) + (ApExcel.Cells(i, 12))))) 'prommdmdm
ApExcel.Cells(i, 16).Value = (ApExcel.Cells(i, 4) + (ApExcel.Cells(i,
7) + (ApExcel.Cells(i, 10) + (ApExcel.Cells(i, 13)))))
ApExcel.Cells(i, 17).Value = (ApExcel.Cells(i, 5) + (ApExcel.Cells(i,
8) + (ApExcel.Cells(i, 11) + (ApExcel.Cells(i, 14)))))
End If
i = i + 10
RST_EMPLEADO.Close
RST_SECCION.MoveNext
Wend
desconectar
Set objLibro = ApExcel.Worksheets(1)
'guardamos cerramos y quitamos excel
ApExcel.Worksheets(1).SaveAs arch
ApExcel.Workbooks.Close
ApExcel.Quit
Set ApExcel = Nothing
MsgBox "Se ha generado el Reporte", vbInformation
End If
Mdi_Frm_Incentivos.MousePointer = 0
End Sub
el erro lo da al querer almacenar los datos en winxp si funciona pero en
98 no ayuda
Leer las respuestas