Exportar hacia Excel

por JoseRios Lun Feb 25, 2008 1:46 pm

Aquí un ejemplo de una Exportación a Excel

Código:: On Error Goto errr Dim ws As New NotesUIWorkspace Dim s As New NotesSession Dim db As NotesDatabase Dim view As NotesView Dim viewE As NotesView Dim dc As NotesDocumentCollection Dim dcM As NotesDocumentCollection Dim doc As NotesDocument Dim docA As NotesDocument Dim docE As NotesDocument Dim docEs As NotesDocument Dim uidoc As NotesUIDocument Dim key, Curso As String Dim i, j, k, l, m As Integer Dim Tt, Ttm As Integer Dim Prm, Prmm As Double Dim PrmA, PrmL, PrmMo, Co As Double Dim Alumno() As String Dim AlumnNo() As Double Dim PA, PL, PM, PS, PANF, PLNF, PMNF, PSNF As Double Set xlApp = CreateObject("Excel.application") xlApp.Workbooks.Add XlApp.Windows(1).DisplayGridlines = True xlApp.Visible = False Set db=s.CurrentDatabase Set view=db.GetView("(AlumnosxCurso)") Set viewE=db.GetView("(SearchEstructura)") Set uidoc=ws.CurrentDocument Set docA=uidoc.Document Curso=docA.Curso(0) Set docEs=viewE.GetDocumentByKey(Curso) PrmA=0 PrmL=0 PrmMo=0 PA=0 PL=0 PM=0 PS=0 PANF=0 PLNF=0 PMNF=0 PSNF=0 If docEs Is Nothing Then Msgbox "El curso seleccionado no existe, por favor verifique o seleccione de nuevo", 64, "Informe de Notas" Exit Sub Else If Isnumeric(docEs.PorcentActividad(0)) Then PA=docEs.PorcentActividad(0)/100 If Isnumeric(docEs.PorcentControles(0)) Then PL=docEs.PorcentControles(0)/100 If Isnumeric(docEs.PorcentModulos(0)) Then PM=docEs.PorcentModulos(0)/100 If Isnumeric(docEs.PorcentSesion(0)) Then PS=docEs.PorcentSesion(0)/100 If Isnumeric(docEs.PorcentActividadNF(0)) Then PANF=docEs.PorcentActividadNF(0)/100 If Isnumeric(docEs.PorcentControlesNF(0)) Then PLNF=docEs.PorcentControlesNF(0)/100 If Isnumeric(docEs.PorcentModulosNF(0)) Then PMNF=docEs.PorcentModulosNF(0)/100 If Isnumeric(docEs.PorcentSesionNF(0)) Then PSNF=docEs.PorcentSesionNF(0)/100 End If Set dc=view.GetAllDocumentsByKey(Curso) Redim Alumno(dc.Count) Redim AlumnNo(dc.Count) Set doc=dc.GetFirstDocument i=1 While Not doc Is Nothing i=i+1 '<-- hoja de libro If i>3 Then XlApp.Worksheets.Add Set xlsheet = xlApp.Workbooks(1).Worksheets(2) Else Set xlsheet = xlApp.Workbooks(1).Worksheets(i) End If xlsheet.Name = (i-1) & ".-" & Ucase(Left(doc.NombresAlumno(0), 1) & Left(doc.ApellidoPAlumno(0), 1) & Left(doc.ApellidoMAlumno(0),1)) xlsheet.Range("A1:IV500").font.size = 8 xlsheet.Range("A1:IV500").font.name = "Verdana" Alumno(i-2)=(i-1) & ".-" & Ucase(Left(doc.NombresAlumno(0), 1) & Left(doc.ApellidoPAlumno(0), 1) & Left(doc.ApellidoMAlumno(0),1)) key=doc.RutAlumno(0) & "-" & Curso l=2 '<-- linea en hoja Set view=db.GetView("(InformeLectura)") Set docE=view.GetDocumentByKey(key) If Not docE Is Nothing Then Tt=0 Prm=0 k=0 xlsheet.cells(l+1, 1).font.Bold=True xlsheet.cells(l+1, 1).value=docE.NombreAlumno(0) & " " & docE.ApellidoPAlumno(0) m=1 For j=1 To docE.CantLecturas(0) If Isnumeric(docE.GetItemValue("NotaCtrolLec" & j)(0)) And Cstr(docE.GetItemValue("NotaCtrolLec" & j)(0))<>"0" Then If m=1 Then xlsheet.cells(l, m+1).borders(1).Weight=3 xlsheet.cells(l, m+1).HorizontalAlignment = -4108 xlsheet.cells(l, m+1).Interior.ColorIndex = 37 xlsheet.cells(l, m+1).font.Color=-16777024 xlsheet.cells(l, m+1).font.Bold=True xlsheet.cells(l, m+1).value=docE.GetItemValue("NombreControl" & j)(0) xlsheet.cells(l, m+1).borders(3).Weight=3 xlsheet.cells(l, m+1).borders(4).Weight=3 xlsheet.cells(l+1, m+1).Interior.ColorIndex = 35 xlsheet.cells(l+1, m+1).HorizontalAlignment = -4108 xlsheet.cells(l+1, m+1).value=docE.GetItemValue("NotaCtrolLec" & j)(0) Tt=Tt+docE.GetItemValue("NotaCtrolLec" & j)(0) m=m+1 k=k+1 End If Next If k>0 Then Prm=Tt/k xlsheet.cells(l, m+1).borders(2).Weight=3 xlsheet.cells(l, m+1).borders(3).Weight=3 xlsheet.cells(l, m+1).borders(4).Weight=3 xlsheet.cells(l, m+1).font.Bold = True xlsheet.cells(l, m+1).HorizontalAlignment = -4108 xlsheet.cells(l, m+1).Interior.ColorIndex = 37 xlsheet.cells(l, m+1).font.Color=-16777024 xlsheet.cells(l, m+1).font.Size=10 xlsheet.cells(l, m+1).value="Promedio" xlsheet.cells(l+1, m+1).font.Bold = True xlsheet.cells(l+1, m+1).HorizontalAlignment = -4108 xlsheet.cells(l+1, m+1).Interior.ColorIndex = 35 xlsheet.cells(l+1, m+1).value=Prm PrmL=Prm End If l=4 '<-- linea en hoja Set view=db.GetView("(InformeActividad)") Set docE=view.GetDocumentByKey(key) If Not docE Is Nothing Then Tt=0 Prm=0 k=0 m=1 xlsheet.cells(l+1, 1).font.Bold=True xlsheet.cells(l+1, 1).value=docE.NombreAlumno(0) & " " & docE.ApellidoPAlumno(0) For j=1 To docE.CantidadActivi(0) If Isnumeric(docE.GetItemValue("NotaAct" & j)(0)) And Cstr(docE.GetItemValue("NotaAct" & j)(0))<>"0" Then If j=1 Then xlsheet.cells(l, j+1).borders(1).Weight=3 xlsheet.cells(l, m+1).HorizontalAlignment = -4108 xlsheet.cells(l, m+1).Interior.ColorIndex = 37 xlsheet.cells(l, m+1).font.Color=-16777024 xlsheet.cells(l, m+1).font.Bold=True xlsheet.cells(l, m+1).value=docE.GetItemValue("NombreActividad" & j)(0) xlsheet.cells(l, m+1).borders(3).Weight=3 xlsheet.cells(l, m+1).borders(4).Weight=3 xlsheet.cells(l+1, m+1).Interior.ColorIndex = 35 xlsheet.cells(l+1, m+1).HorizontalAlignment = -4108 xlsheet.cells(l+1, m+1).value=docE.GetItemValue("NotaAct" & j)(0) Tt=Tt+docE.GetItemValue("NotaAct" & j)(0) k=k+1 m=m+1 End If Next If k>0 Then Prm=Tt/k xlsheet.cells(l, m+1).borders(2).Weight=3 xlsheet.cells(l, m+1).borders(3).Weight=3 xlsheet.cells(l, m+1).borders(4).Weight=3 xlsheet.cells(l, m+1).font.Bold = True xlsheet.cells(l, m+1).HorizontalAlignment = -4108 xlsheet.cells(l, m+1).Interior.ColorIndex = 37 xlsheet.cells(l, m+1).font.Color=-16777024 xlsheet.cells(l, m+1).font.Size=10 xlsheet.cells(l, m+1).value="Promedio" xlsheet.cells(l+1, m+1).font.Bold = True xlsheet.cells(l+1, m+1).HorizontalAlignment = -4108 xlsheet.cells(l+1, m+1).Interior.ColorIndex = 35 xlsheet.cells(l+1, m+1).value=Prm PrmA=Prm End If l=l+3 xlsheet.cells(l, 2).Interior.ColorIndex = 37 xlsheet.cells(l, 3).Interior.ColorIndex = 37 xlsheet.cells(l, 2).font.Color=-16777024 xlsheet.cells(l, 2).font.Bold=True xlsheet.cells(l, 2).borders(1).Weight=3 xlsheet.cells(l, 2).borders(3).Weight=3 xlsheet.cells(l, 2).borders(4).Weight=3 xlsheet.cells(l, 3).borders(2).Weight=3 xlsheet.cells(l, 3).borders(3).Weight=3 xlsheet.cells(l, 3).borders(4).Weight=3 xlsheet.cells(l, 2).value="Modulos" l=l+1 Set view=db.GetView("(InformeModulo)") Set dcM=view.GetAllDocumentsByKey(key) Tt=0 k=0 Prm=0 Set docE=dcM.GetFirstDocument While Not docE Is Nothing Ttm=0 Prmm=0 m=0 For j=1 To docE.CantNotasMod(0) If Isnumeric(docE.GetItemValue("NotaMod" & j)(0)) And Cstr(docE.GetItemValue("NotaMod" & j)(0))<>"0" Then Ttm=Ttm+docE.GetItemValue("NotaMod" & j)(0) m=m+1 End If Next If m>0 Then Prmm=Ttm/m xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).Interior.ColorIndex = 35 xlsheet.cells(l, 2).value=docE.NomModulo(0) xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).Interior.ColorIndex = 40 xlsheet.cells(l, 3).value=Prmm l=l+1 Prm=Prm+Prmm k=k+1 Set docE=dcM.GetNextDocument(docE) Wend If k>0 Then Prm = Prm/k xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).font.size = 10 xlsheet.cells(l, 2).Interior.ColorIndex = 19 xlsheet.cells(l, 2).value="Total Modulos" xlsheet.cells(l, 3).font.Bold = True xlsheet.cells(l, 3).font.size = 10 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).Interior.ColorIndex = 19 xlsheet.cells(l, 3).value=Prm PrmMo=Prm l=l+2 xlsheet.cells(l, 2).Interior.ColorIndex = 37 xlsheet.cells(l, 3).Interior.ColorIndex = 37 xlsheet.cells(l, 2).font.Color=-16777024 xlsheet.cells(l, 2).font.Bold=True xlsheet.cells(l, 2).borders(1).Weight=3 xlsheet.cells(l, 2).borders(3).Weight=3 xlsheet.cells(l, 2).borders(4).Weight=3 xlsheet.cells(l, 3).borders(2).Weight=3 xlsheet.cells(l, 3).borders(3).Weight=3 xlsheet.cells(l, 3).borders(4).Weight=3 xlsheet.cells(l, 2).value="PCI" l=l+1 xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).Interior.ColorIndex = 35 xlsheet.cells(l, 2).value="Lecturas" xlsheet.cells(l, 3).Interior.ColorIndex = 40 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).value=PrmL l=l+1 xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).Interior.ColorIndex = 35 xlsheet.cells(l, 2).value="Actividades" xlsheet.cells(l, 3).Interior.ColorIndex = 40 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).value=PrmA l=l+1 Set view=db.GetView("(InformeSesion)") Set docE=view.GetDocumentByKey(key) If Not docE Is Nothing Then If Isnumeric(docE.NotaSesionCoaching(0)) And Cstr(docE.NotaSesionCoaching(0))<>"0" Then xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).Interior.ColorIndex = 35 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 2).value="Sesión de Coaching" xlsheet.cells(l, 3).Interior.ColorIndex = 40 xlsheet.cells(l, 3).value=docE.NotaSesionCoaching(0) Co=docE.NotaSesionCoaching(0) l=l+1 Else Co=0 End If End If xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).font.size = 10 xlsheet.cells(l, 2).Interior.ColorIndex = 19 xlsheet.cells(l, 3).Interior.ColorIndex = 19 xlsheet.cells(l, 2).value="Total PCI" xlsheet.cells(l, 3).font.Bold = True xlsheet.cells(l, 3).font.size = 10 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).value=(PrmL*PL)+(PrmA*PA)+(Co*PS) l=l+2 xlsheet.cells(l, 2).font.Bold = True xlsheet.cells(l, 2).font.size = 10 xlsheet.cells(l, 2).Interior.ColorIndex = 19 xlsheet.cells(l, 3).Interior.ColorIndex = 19 xlsheet.cells(l, 2).value="Nota Final" xlsheet.cells(l, 3).font.Bold = True xlsheet.cells(l, 3).font.size = 10 xlsheet.cells(l, 3).HorizontalAlignment = -4152 xlsheet.cells(l, 3).value=(PrmMo*PMNF)+(PrmL*PLNF)+(PrmA*PANF)+(Co*PSNF) AlumnNo(i-2)=(PrmMo*PMNF)+(PrmL*PLNF)+(PrmA*PANF)+(Co*PSNF) xlsheet.Columns("A:IV").Columns.AutoFit Set doc=dc.GetNextDocument(doc) Wend Set xlsheet = xlApp.Workbooks(1).Worksheets(1) xlsheet.Activate xlsheet.Name="Resumen de Notas" l=3 xlsheet.Range("A3:D3").Interior.ColorIndex = 37 xlsheet.Range("A3:D3").font.Bold=True xlsheet.Range("A3:D3").HorizontalAlignment = -4108 xlsheet.cells(l, 1).value="Alumno" xlsheet.cells(l, 2).value="Nota Final" xlsheet.cells(l, 3).value="Aprobado" xlsheet.cells(l, 4).value="Pendiente" l=4 For i = 0 To Ubound(Alumno)-1 xlsheet.cells(l, 1).Interior.ColorIndex = 35 xlsheet.cells(l, 2).Interior.ColorIndex = 40 xlsheet.cells(l, 3).Interior.ColorIndex = 19 xlsheet.cells(l, 4).Interior.ColorIndex = 19 xlsheet.cells(l, 1).value=Alumno(i) xlsheet.cells(l, 2).HorizontalAlignment = -4152 xlsheet.cells(l, 2).value=AlumnNo(i) xlsheet.cells(l, 3).HorizontalAlignment = -4108 xlsheet.cells(l, 4).HorizontalAlignment = -4108 l=l+1 Next xlsheet.Columns("A:IV").Columns.AutoFit xlApp.range("A1").Select xlApp.Visible = True Exit Sub errr: Msgbox Error & ", en linea " & Erl Exit Sub