tomar rango en excel

[lokoman]

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:

Dim xlApp As excel.Application
    Dim xlBook As excel.Workbook
    Dim xlSheet As excel.Worksheet
    
    Set xlApp = New excel.Application 
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets.Add
    
    DoEvents
 
'CENTRADO DE LA PAGINA    
    xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
 
'ENCABEZADOS
    xlApp.ActiveSheet.LeftHeader = ""
    xlApp.ActiveSheet.CenterHeader = "ESTA ES UNA PRUEBA DE ENCABEZADO CENTRADO"
    xlApp.ActiveSheet.RightHeader = ""
 
'PIE DE PAGINAS
    xlApp.ActiveSheet.LeftFooter = ""
    xlApp.ActiveSheet.CenterFooter = ""
    xlApp.ActiveSheet.RightFooter = ""
 
'MARGENES
    xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
    xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
    xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
    xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
    xlApp.ActiveWindow.DisplayGridlines = False
 
'FORMATOS DE NUMERO PARA TODA LA COLUMNA
    xlApp.Range("G:G").Style = "Comma"
 
'ALINEACION HORIZONTAL
    xlSheet.Range("A1:J1").HorizontalAlignment = xlCenter
 
'ALINEAZION VERTICAL
    xlSheet.Range("A5:J5").VerticalAlignment = xlCenter
 

Este otro es para exportar un listview a excel:

Código vb:

EXPORTAR LISTVEW A EXCEL
 
Sub Exportar_Excel()
    On Error GoTo SaveErr
    
    Dim TMP
    Dim I, J As Integer
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim CellCnt As Integer 'contar las celdas
    
    Set xlApp = New Excel.Application 'asignar las referencias a las variables
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets.Add
    
    lblProceso.Caption = "Exportando a Excel..."
    DoEvents
    
    xlApp.ActiveSheet.PageSetup.CenterHorizontally = True
    xlApp.ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.22)
    xlApp.ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.18)
    xlApp.ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.34)
    xlApp.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.34)
    
    xlApp.ActiveSheet.PageSetup.Orientation = xlPortrait
    xlApp.ActiveWindow.DisplayGridlines = False
    
    xlSheet.Cells(1, 1).Value = "TITULO"
    xlSheet.Cells(1, 1).Interior.ColorIndex = 33
    xlSheet.Cells(1, 1).Font.Bold = True
    xlSheet.Cells(1, 1).HorizontalAlignment = xlCenter
    
    xlSheet.Cells(2, 1).Value = Now()
    xlSheet.Cells(2, 1).Font.Bold = True
    xlSheet.Cells(2, 1).HorizontalAlignment = xlCenter
    
    xlSheet.Cells(3, 1).Value = "'" & Trim(txtRuta.Text)
    xlSheet.Cells(3, 1).Font.Bold = True
    xlSheet.Cells(3, 1).HorizontalAlignment = xlCenter
    
    xlSheet.Range("A1:E1").Merge
    xlSheet.Range("A2:E2").Merge
    xlSheet.Range("A3:E3").Merge
    
    xlSheet.Range("A1:E1").BorderAround xlContinuous, xlThin
    xlSheet.Range("A2:E2").BorderAround xlContinuous, xlThin
    xlSheet.Range("A3:E3").BorderAround xlContinuous, xlThin
    
    I = 5       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
    CellCnt = 1 'CONTEO DE COLUMNAS
    
    TMP = lsvData.ColumnHeaders.Item(1)  ' OBTENER EL HEADER ITEM DEL LISTVEW
    For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
        xlSheet.Cells(I, CellCnt) = lsvData.ColumnHeaders(CellCnt).Text
        xlSheet.Cells(I, CellCnt).Interior.ColorIndex = 33
        xlSheet.Cells(I, CellCnt).Font.Bold = True
        xlSheet.Cells(I, CellCnt).BorderAround xlContinuous
        xlSheet.Cells(I, CellCnt).HorizontalAlignment = xlCenter
        DoEvents
        lblProceso.Visible = True
        lblProceso.Caption = "Creando cabecera..."
    Next
    
    I = 6       '"i" MARCA EL INICIO DE LOS DATOS DE LA TABLA
    CellCnt = 1 'CONTEO DE COLUMNAS
    
    For J = 1 To lsvData.ListItems.Count
        TMP = lsvData.ListItems.Item(I - 5) ' OBTENER EL ITEM DEL LISTVEW
        xlSheet.Cells(I, 1) = Val(lsvData.ListItems(I - 5))
        For CellCnt = 1 To lsvData.ColumnHeaders.Count - 1
            If CellCnt = 1 Then
                xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
                xlSheet.Cells(I, CellCnt + 1).HorizontalAlignment = xlLeft
            ElseIf CellCnt = 2 Or CellCnt = 3 Or CellCnt = 4 Then
                    If lsvData.ListItems(I - 5).SubItems(CellCnt) = Empty Then
                        xlSheet.Cells(I, CellCnt + 1) = 0
                    Else
                        xlSheet.Cells(I, CellCnt + 1) = lsvData.ListItems(I - 5).SubItems(CellCnt)
                    End If
            End If
        Next
        DoEvents
        lblProceso.Caption = "Añadiendo datos a Excel... " & FormatNumber(J, 0)
        I = I + 1
    Next J
    
    lblProceso.Visible = False
    
    xlApp.Range("C:C").NumberFormat = "#,##0"
    xlApp.Range("D:D").NumberFormat = "#,##0"
    xlApp.Range("E:E").NumberFormat = "#,##0"
    
    xlApp.Range("A5:I" & (lsvData.ListItems.Count + 5)).Sort Key1:=xlSheet.Range("A6"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
'Ajustar todas las columnas
    For J = 1 To lsvData.ColumnHeaders.Count
        xlSheet.Columns(J).AutoFit
    Next J
 
'Salvar la hoja de excel
    xlSheet.Name = "EXPORT"
    
    Gif.Visible = False
    
    CD.FileName = "EXPORT - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xls"
    CD.ShowSave
    xlSheet.SaveAs CD.FileName
    MsgBox "Consulta exportada a MS-Excel.", vbInformation
    
    xlBook.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
Exit Sub
SaveErr:
    If Err.Number <> 32755 Then
        MsgBox "Ocurrió un error!!" & vbNewLine & "[ " & Err.Description & " ]", vbExclamation
    End If
End Sub