Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

tomar rango en excel

 Estas en el tema de tomar rango en excel en el foro de Visual Basic clásico en Foros del Web. como puedo decir quiero los datos de A1 hasta A12 o de A1 a c1? gracias...
  #1 (permalink)  
Antiguo 15/12/2010, 13:20
 
Fecha de Ingreso: noviembre-2009
Mensajes: 315
Antigüedad: 14 años, 5 meses
Puntos: 0
tomar rango en excel
como puedo decir quiero los datos de A1 hasta A12 o de A1 a c1?
gracias
  #2 (permalink)  
Antiguo 15/12/2010, 22:16
Avatar de lokoman  
Fecha de Ingreso: septiembre-2009
Mensajes: 502
Antigüedad: 14 años, 7 meses
Puntos: 47
Respuesta: tomar rango en excel
xlSheet.Range("A1:A12")
  #3 (permalink)  
Antiguo 16/12/2010, 18:16
 
Fecha de Ingreso: noviembre-2009
Mensajes: 315
Antigüedad: 14 años, 5 meses
Puntos: 0
Respuesta: tomar rango en excel
Cita:
Iniciado por lokoman Ver Mensaje
xlSheet.Range("A1:A12")
me sale se requiere un objeto.

lokoman otra consulta es posible usar un archivo excel como una base de datos de access??
lo que quiero es que la planilla que me entregan en excel poder filtrarla con consultas sql.
si no es haci sabes como puedo filtrar usando visual??

filtrar con mas de 1 criterio.

muuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuchas gracias
  #4 (permalink)  
Antiguo 17/12/2010, 20:15
Avatar de lokoman  
Fecha de Ingreso: septiembre-2009
Mensajes: 502
Antigüedad: 14 años, 7 meses
Puntos: 47
Respuesta: tomar rango en excel
Excel puede funcionar como una base de datos e incluso, puedes usar sentencias SQL para hacer SELECT, INSERT, UPDATE y DELETE, para esto debes tener los datos formateados (no tener texto en columnas de numeros porque puede dar error), evitar las celdas en blanco y tener como nombre de campos la primera celda de cada columna, evitar los caracteres apostrofes simples ( ' ).

Te dejo algunos codigos para excel:
Código vb: 
Ver original
  1. Dim xlApp As excel.Application
  2.     Dim xlBook As excel.Workbook
  3.     Dim xlSheet As excel.Worksheet
  4.     
  5.     Set xlApp = New excel.Application 
  6.     Set xlBook = xlApp.Workbooks.Add
  7.     Set xlSheet = xlBook.Worksheets.Add
  8.     
  9.     DoEvents
  10.  
  11. 'CENTRADO DE LA PAGINA    
  12.     xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
  13.  
  14. 'ENCABEZADOS
  15.     xlApp.ActiveSheet.LeftHeader = ""
  16.     xlApp.ActiveSheet.CenterHeader = "ESTA ES UNA PRUEBA DE ENCABEZADO CENTRADO"
  17.     xlApp.ActiveSheet.RightHeader = ""
  18.  
  19. 'PIE DE PAGINAS
  20.     xlApp.ActiveSheet.LeftFooter = ""
  21.     xlApp.ActiveSheet.CenterFooter = ""
  22.     xlApp.ActiveSheet.RightFooter = ""
  23.  
  24. 'MARGENES
  25.     xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
  26.     xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
  27.     xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
  28.     xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
  29.     xlApp.ActiveWindow.DisplayGridlines = False
  30.  
  31. 'FORMATOS DE NUMERO PARA TODA LA COLUMNA
  32.     xlApp.Range("G:G").Style = "Comma"
  33.  
  34. 'ALINEACION HORIZONTAL
  35.     xlSheet.Range("A1:J1").HorizontalAlignment = xlCenter
  36.  
  37. 'ALINEAZION VERTICAL
  38.     xlSheet.Range("A5:J5").VerticalAlignment = xlCenter

Este otro es para exportar un listview a excel:
Código vb: 
Ver original
  1. EXPORTAR LISTVEW A EXCEL
  2.  
  3. Sub Exportar_Excel()
  4.     On Error GoTo SaveErr
  5.     
  6.     Dim TMP
  7.     Dim I, J As Integer
  8.     Dim xlApp As Excel.Application
  9.     Dim xlBook As Excel.Workbook
  10.     Dim xlSheet As Excel.Worksheet
  11.     Dim CellCnt As Integer 'contar las celdas
  12.     
  13.     Set xlApp = New Excel.Application 'asignar las referencias a las variables
  14.     Set xlBook = xlApp.Workbooks.Add
  15.     Set xlSheet = xlBook.Worksheets.Add
  16.     
  17.     lblProceso.Caption = "Exportando a Excel..."
  18.     DoEvents
  19.     
  20.     xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
  21.     xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
  22.     xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
  23.     xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
  24.     xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
  25.     
  26.     xlApp.ActiveSheet.PageSetup.Orientation = xlPortrait
  27.     xlApp.ActiveWindow.DisplayGridlines = False
  28.     
  29.     xlSheet.Cells(1, 1).Value = "TITULO"
  30.     xlSheet.Cells(1, 1).Interior.ColorIndex = 33
  31.     xlSheet.Cells(1, 1).Font.Bold = True
  32.     xlSheet.Cells(1, 1).HorizontalAlignment = xlCenter
  33.     
  34.     xlSheet.Cells(2, 1).Value = Now()
  35.     xlSheet.Cells(2, 1).Font.Bold = True
  36.     xlSheet.Cells(2, 1).HorizontalAlignment = xlCenter
  37.     
  38.     xlSheet.Cells(3, 1).Value = "'" & Trim(txtRuta.Text)
  39.     xlSheet.Cells(3, 1).Font.Bold = True
  40.     xlSheet.Cells(3, 1).HorizontalAlignment = xlCenter
  41.     
  42.     xlSheet.Range("A1:E1").Merge
  43.     xlSheet.Range("A2:E2").Merge
  44.     xlSheet.Range("A3:E3").Merge
  45.     
  46.     xlSheet.Range("A1:E1").BorderAround xlContinuous, xlThin
  47.     xlSheet.Range("A2:E2").BorderAround xlContinuous, xlThin
  48.     xlSheet.Range("A3:E3").BorderAround xlContinuous, xlThin
  49.     
  50.     I = 5       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
  51.     CellCnt = 1 'CONTEO DE COLUMNAS
  52.     
  53.     TMP = lsvData.ColumnHeaders.Item(1)  ' OBTENER EL HEADER ITEM DEL LISTVEW
  54.     For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
  55.         xlSheet.Cells(I, CellCnt) = lsvData.ColumnHeaders(CellCnt).Text
  56.         xlSheet.Cells(I, CellCnt).Interior.ColorIndex = 33
  57.         xlSheet.Cells(I, CellCnt).Font.Bold = True
  58.         xlSheet.Cells(I, CellCnt).BorderAround xlContinuous
  59.         xlSheet.Cells(I, CellCnt).HorizontalAlignment = xlCenter
  60.         DoEvents
  61.         lblProceso.Visible = True
  62.         lblProceso.Caption = "Creando cabecera..."
  63.     Next
  64.     
  65.     I = 6       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
  66.     CellCnt = 1 'CONTEO DE COLUMNAS
  67.     
  68.     For J = 1 To lsvData.ListItems.Count
  69.         TMP = lsvData.ListItems.Item(I - 5) ' OBTENER EL ITEM DEL LISTVEW
  70.         xlSheet.Cells(I, 1) = Val(lsvData.ListItems(I - 5))
  71.         For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
  72.             If CellCnt = 1 Then
  73.                 xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
  74.                 xlSheet.Cells(I, CellCnt + 1).HorizontalAlignment = xlLeft
  75.             ElseIf CellCnt = 2 Or CellCnt = 3 Or CellCnt = 4 Then
  76.                     If lsvData.ListItems(I - 5).SubItems(CellCnt) = Empty Then
  77.                         xlSheet.Cells(I, CellCnt + 1) = 0
  78.                     Else
  79.                         xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
  80.                     End If
  81.             End If
  82.         Next
  83.         DoEvents
  84.         lblProceso.Caption = "Añadiendo datos a Excel... " & FormatNumber(J, 0)
  85.         I = I + 1
  86.     Next J
  87.     
  88.     lblProceso.Visible = False
  89.     
  90.     xlApp.Range("C:C").NumberFormat = "#,##0"
  91.     xlApp.Range("D:D").NumberFormat = "#,##0"
  92.     xlApp.Range("E:E").NumberFormat = "#,##0"
  93.     
  94.     xlApp.Range("A5:I" & (lsvData.ListItems.Count + 5)).Sort Key1:=xlSheet.Range("A6"), Order1:=xlAscending, Header:= _
  95.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  96.         DataOption1:=xlSortNormal
  97.         
  98. 'Ajustar todas las columnas
  99.     For J = 1 To lsvData.ColumnHeaders.Count
  100.         xlSheet.Columns(J).AutoFit
  101.     Next J
  102.  
  103. 'Salvar la hoja de excel
  104.     xlSheet.Name = "EXPORT"
  105.     
  106.     Gif.Visible = False
  107.     
  108.     CD.FileName = "EXPORT - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
  109.     CD.ShowSave
  110.     xlSheet.SaveAs CD.FileName
  111.     MsgBox "Consulta exportada a MS-Excel.", vbInformation
  112.     
  113.     xlBook.Close
  114.     xlApp.Quit
  115.     Set xlApp = Nothing
  116.     Set xlBook = Nothing
  117.     Set xlSheet = Nothing
  118. Exit Sub
  119. SaveErr:
  120.     If Err.Number <> 32755 Then
  121.         MsgBox "Ocurrió un error!!" & vbNewLine & "[ " & Err.Description & " ]", vbExclamation
  122.     End If
  123. End Sub
  #5 (permalink)  
Antiguo 19/12/2010, 18:50
 
Fecha de Ingreso: noviembre-2009
Mensajes: 315
Antigüedad: 14 años, 5 meses
Puntos: 0
Respuesta: tomar rango en excel
Cita:
Iniciado por lokoman Ver Mensaje
Excel puede funcionar como una base de datos e incluso, puedes usar sentencias SQL para hacer SELECT, INSERT, UPDATE y DELETE, para esto debes tener los datos formateados (no tener texto en columnas de numeros porque puede dar error), evitar las celdas en blanco y tener como nombre de campos la primera celda de cada columna, evitar los caracteres apostrofes simples ( ' ).

Te dejo algunos codigos para excel:
Código vb: 
Ver original
  1. Dim xlApp As excel.Application
  2.     Dim xlBook As excel.Workbook
  3.     Dim xlSheet As excel.Worksheet
  4.     
  5.     Set xlApp = New excel.Application 
  6.     Set xlBook = xlApp.Workbooks.Add
  7.     Set xlSheet = xlBook.Worksheets.Add
  8.     
  9.     DoEvents
  10.  
  11. 'CENTRADO DE LA PAGINA    
  12.     xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
  13.  
  14. 'ENCABEZADOS
  15.     xlApp.ActiveSheet.LeftHeader = ""
  16.     xlApp.ActiveSheet.CenterHeader = "ESTA ES UNA PRUEBA DE ENCABEZADO CENTRADO"
  17.     xlApp.ActiveSheet.RightHeader = ""
  18.  
  19. 'PIE DE PAGINAS
  20.     xlApp.ActiveSheet.LeftFooter = ""
  21.     xlApp.ActiveSheet.CenterFooter = ""
  22.     xlApp.ActiveSheet.RightFooter = ""
  23.  
  24. 'MARGENES
  25.     xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
  26.     xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
  27.     xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
  28.     xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
  29.     xlApp.ActiveWindow.DisplayGridlines = False
  30.  
  31. 'FORMATOS DE NUMERO PARA TODA LA COLUMNA
  32.     xlApp.Range("G:G").Style = "Comma"
  33.  
  34. 'ALINEACION HORIZONTAL
  35.     xlSheet.Range("A1:J1").HorizontalAlignment = xlCenter
  36.  
  37. 'ALINEAZION VERTICAL
  38.     xlSheet.Range("A5:J5").VerticalAlignment = xlCenter

Este otro es para exportar un listview a excel:
Código vb: 
Ver original
  1. EXPORTAR LISTVEW A EXCEL
  2.  
  3. Sub Exportar_Excel()
  4.     On Error GoTo SaveErr
  5.     
  6.     Dim TMP
  7.     Dim I, J As Integer
  8.     Dim xlApp As Excel.Application
  9.     Dim xlBook As Excel.Workbook
  10.     Dim xlSheet As Excel.Worksheet
  11.     Dim CellCnt As Integer 'contar las celdas
  12.     
  13.     Set xlApp = New Excel.Application 'asignar las referencias a las variables
  14.     Set xlBook = xlApp.Workbooks.Add
  15.     Set xlSheet = xlBook.Worksheets.Add
  16.     
  17.     lblProceso.Caption = "Exportando a Excel..."
  18.     DoEvents
  19.     
  20.     xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
  21.     xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
  22.     xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
  23.     xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
  24.     xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
  25.     
  26.     xlApp.ActiveSheet.PageSetup.Orientation = xlPortrait
  27.     xlApp.ActiveWindow.DisplayGridlines = False
  28.     
  29.     xlSheet.Cells(1, 1).Value = "TITULO"
  30.     xlSheet.Cells(1, 1).Interior.ColorIndex = 33
  31.     xlSheet.Cells(1, 1).Font.Bold = True
  32.     xlSheet.Cells(1, 1).HorizontalAlignment = xlCenter
  33.     
  34.     xlSheet.Cells(2, 1).Value = Now()
  35.     xlSheet.Cells(2, 1).Font.Bold = True
  36.     xlSheet.Cells(2, 1).HorizontalAlignment = xlCenter
  37.     
  38.     xlSheet.Cells(3, 1).Value = "'" & Trim(txtRuta.Text)
  39.     xlSheet.Cells(3, 1).Font.Bold = True
  40.     xlSheet.Cells(3, 1).HorizontalAlignment = xlCenter
  41.     
  42.     xlSheet.Range("A1:E1").Merge
  43.     xlSheet.Range("A2:E2").Merge
  44.     xlSheet.Range("A3:E3").Merge
  45.     
  46.     xlSheet.Range("A1:E1").BorderAround xlContinuous, xlThin
  47.     xlSheet.Range("A2:E2").BorderAround xlContinuous, xlThin
  48.     xlSheet.Range("A3:E3").BorderAround xlContinuous, xlThin
  49.     
  50.     I = 5       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
  51.     CellCnt = 1 'CONTEO DE COLUMNAS
  52.     
  53.     TMP = lsvData.ColumnHeaders.Item(1)  ' OBTENER EL HEADER ITEM DEL LISTVEW
  54.     For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
  55.         xlSheet.Cells(I, CellCnt) = lsvData.ColumnHeaders(CellCnt).Text
  56.         xlSheet.Cells(I, CellCnt).Interior.ColorIndex = 33
  57.         xlSheet.Cells(I, CellCnt).Font.Bold = True
  58.         xlSheet.Cells(I, CellCnt).BorderAround xlContinuous
  59.         xlSheet.Cells(I, CellCnt).HorizontalAlignment = xlCenter
  60.         DoEvents
  61.         lblProceso.Visible = True
  62.         lblProceso.Caption = "Creando cabecera..."
  63.     Next
  64.     
  65.     I = 6       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
  66.     CellCnt = 1 'CONTEO DE COLUMNAS
  67.     
  68.     For J = 1 To lsvData.ListItems.Count
  69.         TMP = lsvData.ListItems.Item(I - 5) ' OBTENER EL ITEM DEL LISTVEW
  70.         xlSheet.Cells(I, 1) = Val(lsvData.ListItems(I - 5))
  71.         For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
  72.             If CellCnt = 1 Then
  73.                 xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
  74.                 xlSheet.Cells(I, CellCnt + 1).HorizontalAlignment = xlLeft
  75.             ElseIf CellCnt = 2 Or CellCnt = 3 Or CellCnt = 4 Then
  76.                     If lsvData.ListItems(I - 5).SubItems(CellCnt) = Empty Then
  77.                         xlSheet.Cells(I, CellCnt + 1) = 0
  78.                     Else
  79.                         xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
  80.                     End If
  81.             End If
  82.         Next
  83.         DoEvents
  84.         lblProceso.Caption = "Añadiendo datos a Excel... " & FormatNumber(J, 0)
  85.         I = I + 1
  86.     Next J
  87.     
  88.     lblProceso.Visible = False
  89.     
  90.     xlApp.Range("C:C").NumberFormat = "#,##0"
  91.     xlApp.Range("D:D").NumberFormat = "#,##0"
  92.     xlApp.Range("E:E").NumberFormat = "#,##0"
  93.     
  94.     xlApp.Range("A5:I" & (lsvData.ListItems.Count + 5)).Sort Key1:=xlSheet.Range("A6"), Order1:=xlAscending, Header:= _
  95.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  96.         DataOption1:=xlSortNormal
  97.         
  98. 'Ajustar todas las columnas
  99.     For J = 1 To lsvData.ColumnHeaders.Count
  100.         xlSheet.Columns(J).AutoFit
  101.     Next J
  102.  
  103. 'Salvar la hoja de excel
  104.     xlSheet.Name = "EXPORT"
  105.     
  106.     Gif.Visible = False
  107.     
  108.     CD.FileName = "EXPORT - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
  109.     CD.ShowSave
  110.     xlSheet.SaveAs CD.FileName
  111.     MsgBox "Consulta exportada a MS-Excel.", vbInformation
  112.     
  113.     xlBook.Close
  114.     xlApp.Quit
  115.     Set xlApp = Nothing
  116.     Set xlBook = Nothing
  117.     Set xlSheet = Nothing
  118. Exit Sub
  119. SaveErr:
  120.     If Err.Number <> 32755 Then
  121.         MsgBox "Ocurrió un error!!" & vbNewLine & "[ " & Err.Description & " ]", vbExclamation
  122.     End If
  123. End Sub
man tengo un archivo de excel que no tiene formatos y lo que hago es ordenarlo acendente y lo que tengo que lograr es que por ejemplo tengo esta columna

1
1
1
1
2
2
2
2
3
3
4

enconces tomar primero todos los datos que correspondan al 1 y pegarlos en otro libro para asi sacar solo los datos que necesito y poder imprimir y guardar un respaldo.
esto lo deveria hacer con los datos del 2,3 y 4.

espero me entiendas y me puedas ayudar ya que no se como filtrar (sacar solo los datos del 1) y es necesario que cree otro documento para hacer la planilla que necesito?

muchas gracias
  #6 (permalink)  
Antiguo 19/12/2010, 22:47
Avatar de lokoman  
Fecha de Ingreso: septiembre-2009
Mensajes: 502
Antigüedad: 14 años, 7 meses
Puntos: 47
Respuesta: tomar rango en excel
Puedes usar una sentencia SQL en un recordset:
"SELECT * FROM [HOJA$] WHERE [NOMBRE_COLUMNA]=" & 1

eso te cargaria todos los registros que sean "1", a partir de ahi lo copias en otro archivo excel, este seria el proceso:

1-Conectarse al archivo de excel
2-Leer los registros que sean "1"
3-Copiar los registros que sean "1" en un archivo excel nuevo

ejem.:
Código vb: 
Ver original
  1. 'PARA OBTENER EL NOMBRE DE LA  HOJA ACTIVA
  2.                 Dim ObjExcel As Object
  3.                 Set ObjExcel = CreateObject("Excel.Application")
  4.                 
  5.                 'Abre los libros
  6.                 ObjExcel.Workbooks.Open "RUTA DEL ARCHIVO DE EXCEL"
  7.                 
  8.                 With ObjExcel
  9.                     .ActiveSheet.Select ' La selecciona
  10.                     NombreHoja = UCase(.ActiveSheet.Name)
  11.                 End With
  12.                 
  13.                 'Descarga la referencia y cierra el Excel
  14.                 ObjExcel.Quit
  15.                 Set ObjExcel = Nothing
  16.                 
  17.                 DoEvents
  18.                         
  19. 'CONEXION A LOS ARCHIVOS EXCEL
  20.                Dim Conn As ADODB.Connection
  21.                Dim Rec As New ADODB.Recordset
  22.  
  23.                 Set Conn = New ADODB.Connection
  24.                 
  25.                 With Conn
  26.                     .Provider = "MSDASQL"
  27.                     .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
  28.                     "DBQ=" & Trim(RUTA DEL ARCHIVO DE EXCEL) & "; ReadOnly=False;"
  29.                     Conn.Open
  30.                 End With
  31.  
  32.                 Rec.Source = "SELECT * FROM [" & Trim(NombreHoja) & "$] WHERE [COLUMNA]=" & 1
  33.                 Rec.Open , Conn, adOpenForwardOnly, adLockReadOnly
  34.         
  35.                 If Not Rec.EOF Then
  36.                         Dim xlApp As Excel.Application
  37.                         Dim xlBook As Excel.Workbook
  38.                         Dim xlSheet As Excel.Worksheet
  39.                         Dim CellCnt As Double
  40.                         Dim I, J As Double
  41.  
  42.     
  43.                         Set xlApp = New Excel.Application 'asignar las referencias a las variables
  44.                         Set xlBook = xlApp.Workbooks.Add
  45.                         Set xlSheet = xlBook.Worksheets.Add
  46.     
  47.                         I = 2      
  48.                         CellCnt = 1 
  49.  
  50.                         DO WHILE REC.EOF=FALSE
  51.                              xlSheet.Cells(I, CellCnt) = REC!COLUMNA
  52.                              I = I + 1
  53.                             DOEVENTS
  54.                         LOOP
  55.  
  56. 'Ajustar todas las columnas
  57.                         For J = 1 To lsvData.ColumnHeaders.Count
  58.                             xlSheet.Columns(J).AutoFit
  59.                         Next J
  60.  
  61. 'Salvar la hoja de excel
  62.                         xlSheet.Name = "EXPORT"
  63.                         xlSheet.SaveAs "EXPORT.XLS"
  64.                         MsgBox "Consulta exportada a Excel!!", vbInformation
  65.  
  66.                         xlBook.Close
  67.                         if rec.state=1 then rec.close
  68.                         xlApp.Quit
  69.                         Set xlApp = Nothing
  70.                         Set xlBook = Nothing
  71.                         Set xlSheet = Nothing
  72.                         Set rec=nothing
  73.                     End if

Ajusta el code
  #7 (permalink)  
Antiguo 21/12/2010, 05:50
 
Fecha de Ingreso: noviembre-2009
Mensajes: 315
Antigüedad: 14 años, 5 meses
Puntos: 0
Respuesta: tomar rango en excel
Cita:
Iniciado por lokoman Ver Mensaje
Puedes usar una sentencia SQL en un recordset:
"SELECT * FROM [HOJA$] WHERE [NOMBRE_COLUMNA]=" & 1

eso te cargaria todos los registros que sean "1", a partir de ahi lo copias en otro archivo excel, este seria el proceso:

1-Conectarse al archivo de excel
2-Leer los registros que sean "1"
3-Copiar los registros que sean "1" en un archivo excel nuevo

ejem.:
Código vb: 
Ver original
  1. 'PARA OBTENER EL NOMBRE DE LA  HOJA ACTIVA
  2.                 Dim ObjExcel As Object
  3.                 Set ObjExcel = CreateObject("Excel.Application")
  4.                 
  5.                 'Abre los libros
  6.                 ObjExcel.Workbooks.Open "RUTA DEL ARCHIVO DE EXCEL"
  7.                 
  8.                 With ObjExcel
  9.                     .ActiveSheet.Select ' La selecciona
  10.                     NombreHoja = UCase(.ActiveSheet.Name)
  11.                 End With
  12.                 
  13.                 'Descarga la referencia y cierra el Excel
  14.                 ObjExcel.Quit
  15.                 Set ObjExcel = Nothing
  16.                 
  17.                 DoEvents
  18.                         
  19. 'CONEXION A LOS ARCHIVOS EXCEL
  20.                Dim Conn As ADODB.Connection
  21.                Dim Rec As New ADODB.Recordset
  22.  
  23.                 Set Conn = New ADODB.Connection
  24.                 
  25.                 With Conn
  26.                     .Provider = "MSDASQL"
  27.                     .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
  28.                     "DBQ=" & Trim(RUTA DEL ARCHIVO DE EXCEL) & "; ReadOnly=False;"
  29.                     Conn.Open
  30.                 End With
  31.  
  32.                 Rec.Source = "SELECT * FROM [" & Trim(NombreHoja) & "$] WHERE [COLUMNA]=" & 1
  33.                 Rec.Open , Conn, adOpenForwardOnly, adLockReadOnly
  34.         
  35.                 If Not Rec.EOF Then
  36.                         Dim xlApp As Excel.Application
  37.                         Dim xlBook As Excel.Workbook
  38.                         Dim xlSheet As Excel.Worksheet
  39.                         Dim CellCnt As Double
  40.                         Dim I, J As Double
  41.  
  42.     
  43.                         Set xlApp = New Excel.Application 'asignar las referencias a las variables
  44.                         Set xlBook = xlApp.Workbooks.Add
  45.                         Set xlSheet = xlBook.Worksheets.Add
  46.     
  47.                         I = 2      
  48.                         CellCnt = 1 
  49.  
  50.                         DO WHILE REC.EOF=FALSE
  51.                              xlSheet.Cells(I, CellCnt) = REC!COLUMNA
  52.                              I = I + 1
  53.                             DOEVENTS
  54.                         LOOP
  55.  
  56. 'Ajustar todas las columnas
  57.                         For J = 1 To lsvData.ColumnHeaders.Count
  58.                             xlSheet.Columns(J).AutoFit
  59.                         Next J
  60.  
  61. 'Salvar la hoja de excel
  62.                         xlSheet.Name = "EXPORT"
  63.                         xlSheet.SaveAs "EXPORT.XLS"
  64.                         MsgBox "Consulta exportada a Excel!!", vbInformation
  65.  
  66.                         xlBook.Close
  67.                         if rec.state=1 then rec.close
  68.                         xlApp.Quit
  69.                         Set xlApp = Nothing
  70.                         Set xlBook = Nothing
  71.                         Set xlSheet = Nothing
  72.                         Set rec=nothing
  73.                     End if

Ajusta el code

la consulta la puedo hacer en el editor de visual basic que trae excel

Etiquetas: excel, rango, tomar
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta


« Tema Anterior | Próximo Tema »


La zona horaria es GMT -6. Ahora son las 08:30.