| Aqui va desde Access a Excel
Public oExcelApp As excel.Application
Public oWs As excel.Worksheet
Public oWb As excel.Workbook
Public sNewXlsFile As String
Public sOldXlsFile As String
Public sRowData As String
Public cEmpresa As String
Const cNUMCOLS = 13
Const cNUMROWS = 1000
Const cFIXEDROWS = 8
Const cCLIPROWS = 500
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub pbGenerar_Click()
sNewXlsFile = "C:\SQL\Archivo_" & CStr(Year(Date)) & "_" & CStr(Month(Date)) & "_" & CStr(Day(Date))
sOldXlsFile = "C:\SQL\Hoja.xls"
Set oExcelApp = CreateObject("EXCEL.APPLICATION")
oExcelApp.Visible = False
oExcelApp.Workbooks.Open FileName:=sOldXlsFile, ReadOnly:=False, ignoreReadOnlyRecommended:=True
Set oWs = oExcelApp.ActiveSheet
Set oWb = oExcelApp.ActiveWorkbook
oWs.SaveAs FileName:=sNewXlsFile, FileFormat:=xlNormal
cEmpresa = "Empresa1 S.A."
A_Excel
oWb.Save
oWb.Saved = True
oExcelApp.Quit
Set oWs = Nothing
Set oWb = Nothing
Set oExcelApp = Nothing
Unload Me
End Sub
Sub A_Excel()
Data1.RecordSource = "SELECT DISTINCT En_CQ.Fecha_Carga, En_Ans.ID_Requerimiento as ANS, En_CQ.ID_Requerimiento, Pais, Cliente, Nombre_Sistema, Tipo_Mant, Prioridad, Propietario, Estado, Fecha_Pedido, Fecha_Primera_Resp, Fecha_Est_Termino, Headline, Submitter"
Data1.RecordSource = Data1.RecordSource & " FROM En_CQ LEFT JOIN En_Ans ON En_CQ.ID_Requerimiento = En_Ans.ID_Requerimiento"
Data1.RecordSource = Data1.RecordSource & " WHERE Cliente='" & cEmpresa & "' and Month(En_CQ.Fecha_Carga)= " & CStr(Month(Date)) & " and Year(En_CQ.Fecha_Carga)= " & CStr(Year(Date)) & " and Day(En_CQ.Fecha_Carga)= " & CStr(Day(Date))
Data1.RecordSource = Data1.RecordSource & " ORDER BY Nombre_Sistema, Tipo_Mant, Prioridad"
Data1.Refresh
sStart = "A" & CStr(cFIXEDROWS + 1)
sLtr = Mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", cNUMCOLS + 1, 1)
sEnd = sLtr & CStr(cFIXEDROWS + cNUMROWS + 1)
sSelData = ""
lRowCount = 0
lPasteCount = 0
While Not Data1.Recordset.EOF
sRowData = ""
sRowData = sRowData & IIf(IsNull(Data1.Recordset!ANS), "", "SI") & vbTab
sRowData = sRowData & Data1.Recordset!ID_Requerimiento & vbTab
sRowData = sRowData & Data1.Recordset!Pais & vbTab
sRowData = sRowData & Data1.Recordset!Propietario & vbTab
sRowData = sRowData & Data1.Recordset!Nombre_Sistema & vbTab
sRowData = sRowData & Data1.Recordset!Cliente & vbTab
sRowData = sRowData & Data1.Recordset!Tipo_Mant & vbTab
sRowData = sRowData & Data1.Recordset!Prioridad & vbTab
sRowData = sRowData & Data1.Recordset!Estado & vbTab
cFec_Ped = CStr(Data1.Recordset!Fecha_Pedido)
dFec_Ped = Mid(cFec_Ped, 4, 3) & Mid(cFec_Ped, 1, 3) & Mid(cFec_Ped, 7)
sRowData = sRowData & CDate(dFec_Ped) & vbTab
If Not IsNull(Data1.Recordset!Fecha_Primera_Resp) Then
cFec_Ped = CStr(Data1.Recordset!Fecha_Primera_Resp)
dFec_Ped = Mid(cFec_Ped, 4, 3) & Mid(cFec_Ped, 1, 3) & Mid(cFec_Ped, 7)
sRowData = sRowData & CDate(dFec_Ped) & vbTab
Else
sRowData = sRowData & Data1.Recordset!Fecha_Primera_Resp & vbTab
End If
If IsNull(Data1.Recordset!Fecha_Est_Termino) Then
sRowData = sRowData & Data1.Recordset!Fecha_Est_Termino & vbTab
Else
cFec_Ped = CStr(Data1.Recordset!Fecha_Est_Termino)
dFec_Ped = Mid(cFec_Ped, 4, 3) & Mid(cFec_Ped, 1, 3) & Mid(cFec_Ped, 7)
sRowData = sRowData & CDate(dFec_Ped) & vbTab
End If
sRowData = sRowData & Data1.Recordset!Headline & vbTab
sRowData = sRowData & Data1.Recordset!Submitter & vbTab
sRowData = Left$(sRowData, Len(sRowData) - 1)
sSelData = sSelData + sRowData + vbCrLf
lRowCount = lRowCount + 1
If lRowCount = cCLIPROWS Then
Clipboard.Clear
Clipboard.SetText sSelData
sSelData = ""
With oWs
.Range("A" & CStr(lPasteCount * cCLIPROWS + cFIXEDROWS)).Select
.Paste
.Range("A1").Select
End With
lRowCount = 0
lPasteCount = lPasteCount + 1
End If
Data1.Recordset.MoveNext
Wend
Clipboard.Clear
Clipboard.SetText sSelData
With oWs
.Range("A" & CStr(lPasteCount * cCLIPROWS + cFIXEDROWS)).Select
.Paste
.Range("A1").Select
End With
End Sub |