Exportar hacia Excel

Ver el tema anterior Ver el tema siguiente Ir abajo

Exportar hacia Excel

Mensaje por JoseRios el 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
avatar
JoseRios

Cantidad de envíos : 39
Edad : 32
Localización : Santiago, Chile
Fecha de inscripción : 25/02/2008

Ver perfil de usuario http://noteroschile.wordpress.com

Volver arriba Ir abajo

Ver el tema anterior Ver el tema siguiente Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.