EXPORTAR PARA EXCEL

USUARIO.EXCLUIDOS 31/08/2007 12:12:28
#233584

Pessoal boa tarde,

Fiz este código mencionado abaixo, mais ele tem que abrir o excel e jogar linha por linha.

Gostaria de saber se tem como eu salvar direto no excel sem precisar abrilo, e tem uma coluna no listview que só tem duas informacoes "ativo e inativo" tem como eu escolher só inativo ou so ativo.

Obrigado.

Private Sub cmdExportar_Click()

   Dim X As Integer
   Dim MyExcel As Excel.Application
   On Error Resume Next
   
   'chama excel
   Set ExcelS = New Excel.Application
    
   'coloca excel visivel na tela
   ExcelS.Visible = True
   
   'adiciona uma planilha
   ExcelS.Workbooks.Add
   
   'seta excel em modo de inserção
   With ExcelS.ActiveSheet
        
    X = 1
    
    'coloca o titulo das colunas do excel de acordo com as do listview
    .Cells(X, "A") = LV5.ColumnHeaders.item(1).Text
    .Cells(X, "B") = LV5.ColumnHeaders.item(2).Text
    .Cells(X, "C") = LV5.ColumnHeaders.item(3).Text
    .Cells(X, "D") = LV5.ColumnHeaders.item(4).Text
    .Cells(X, "E") = LV5.ColumnHeaders.item(5).Text
    .Cells(X, "F") = LV5.ColumnHeaders.item(6).Text
    .Cells(X, "G") = LV5.ColumnHeaders.item(7).Text
    .Cells(X, "H") = LV5.ColumnHeaders.item(8).Text
    .Cells(X, "I") = LV5.ColumnHeaders.item(9).Text
    .Cells(X, "J") = LV5.ColumnHeaders.item(10).Text
    .Cells(X, "K") = LV5.ColumnHeaders.item(11).Text
    .Cells(X, "L") = LV5.ColumnHeaders.item(12).Text
    .Cells(X, "M") = LV5.ColumnHeaders.item(13).Text
    .Cells(X, "N") = LV5.ColumnHeaders.item(14).Text
    .Cells(X, "O") = LV5.ColumnHeaders.item(15).Text
    .Cells(X, "P") = LV5.ColumnHeaders.item(16).Text
    .Cells(X, "Q") = LV5.ColumnHeaders.item(17).Text
    .Cells(X, "R") = LV5.ColumnHeaders.item(18).Text
    .Cells(X, "S") = LV5.ColumnHeaders.item(19).Text
    .Cells(X, "T") = LV5.ColumnHeaders.item(20).Text
    .Cells(X, "U") = LV5.ColumnHeaders.item(21).Text
    .Cells(X, "V") = LV5.ColumnHeaders.item(22).Text
    .Cells(X, "W") = LV5.ColumnHeaders.item(23).Text
    .Cells(X, "X") = LV5.ColumnHeaders.item(24).Text
    .Cells(X, "Y") = LV5.ColumnHeaders.item(25).Text
    .Cells(X, "Z") = LV5.ColumnHeaders.item(26).Text
    .Cells(X, "AA") = LV5.ColumnHeaders.item(27).Text
    .Cells(X, "AB") = LV5.ColumnHeaders.item(28).Text
    .Cells(X, "AC") = LV5.ColumnHeaders.item(29).Text
    .Cells(X, "AD") = LV5.ColumnHeaders.item(30).Text
    .Cells(X, "AE") = LV5.ColumnHeaders.item(31).Text
    .Cells(X, "AF") = LV5.ColumnHeaders.item(32).Text
    .Cells(X, "AG") = LV5.ColumnHeaders.item(33).Text
    .Cells(X, "AH") = LV5.ColumnHeaders.item(34).Text
    .Cells(X, "AI") = LV5.ColumnHeaders.item(35).Text
    .Cells(X, "AJ") = LV5.ColumnHeaders.item(36).Text
    
    'faz um loop por todos os registros do listview e passa pro excel
    For X = 1 To LV5.ListItems.Count
      DoEvents
       .Cells(X + 1, "A") = LV5.ListItems.item(X).Text
       .Cells(X + 1, "B") = LV5.ListItems.item(X).SubItems(1)
       .Cells(X + 1, "C") = LV5.ListItems.item(X).SubItems(2)
       .Cells(X + 1, "D") = LV5.ListItems.item(X).SubItems(3)
       .Cells(X + 1, "E") = LV5.ListItems.item(X).SubItems(4)
       .Cells(X + 1, "F") = LV5.ListItems.item(X).SubItems(5)
       .Cells(X + 1, "G") = LV5.ListItems.item(X).SubItems(6)
       .Cells(X + 1, "H") = LV5.ListItems.item(X).SubItems(7)
       .Cells(X + 1, "I") = LV5.ListItems.item(X).SubItems(8)
       .Cells(X + 1, "J") = LV5.ListItems.item(X).SubItems(9)
       .Cells(X + 1, "K") = LV5.ListItems.item(X).SubItems(10)
       .Cells(X + 1, "L") = LV5.ListItems.item(X).SubItems(11)
       .Cells(X + 1, "M") = LV5.ListItems.item(X).SubItems(12)
       .Cells(X + 1, "N") = LV5.ListItems.item(X).SubItems(13)
       .Cells(X + 1, "O") = LV5.ListItems.item(X).SubItems(14)
       .Cells(X + 1, "P") = LV5.ListItems.item(X).SubItems(15)
       .Cells(X + 1, "Q") = LV5.ListItems.item(X).SubItems(16)
       .Cells(X + 1, "R") = LV5.ListItems.item(X).SubItems(17)
       .Cells(X + 1, "S") = LV5.ListItems.item(X).SubItems(18)
       .Cells(X + 1, "T") = LV5.ListItems.item(X).SubItems(19)
       .Cells(X + 1, "U") = LV5.ListItems.item(X).SubItems(20)
       .Cells(X + 1, "V") = LV5.ListItems.item(X).SubItems(21)
       .Cells(X + 1, "W") = LV5.ListItems.item(X).SubItems(22)
       .Cells(X + 1, "X") = LV5.ListItems.item(X).SubItems(23)
       .Cells(X + 1, "Y") = LV5.ListItems.item(X).SubItems(24)
       .Cells(X + 1, "Z") = LV5.ListItems.item(X).SubItems(25)
       .Cells(X + 1, "AA") = LV5.ListItems.item(X).SubItems(26)
       .Cells(X + 1, "AB") = LV5.ListItems.item(X).SubItems(27)
       .Cells(X + 1, "AC") = LV5.ListItems.item(X).SubItems(28)
       .Cells(X + 1, "AD") = LV5.ListItems.item(X).SubItems(29)
       .Cells(X + 1, "AE") = LV5.ListItems.item(X).SubItems(30)
       .Cells(X + 1, "AF") = LV5.ListItems.item(X).SubItems(31)
       .Cells(X + 1, "AG") = LV5.ListItems.item(X).SubItems(32)
       .Cells(X + 1, "AH") = LV5.ListItems.item(X).SubItems(33)
       .Cells(X + 1, "AI") = LV5.ListItems.item(X).SubItems(34)
       .Cells(X + 1, "AJ") = LV5.ListItems.item(X).SubItems(35)
    Next
    
   End With
   
  'remove o excel da memoria
  Set ExcelS = Nothing
    
  frmCadCliente.SetFocus
    
  MsgBox "Relatório Gerado com Sucesso", vbInformation, "Aviso"

End Sub

USUARIO.EXCLUIDOS 31/08/2007 12:18:09
#233586

Dim rsRelatorio As ADODB.Recordset
Dim objExcel As Object

Private Sub Gera_xls1()
Conexao
        Set rsRelatorio = New ADODB.Recordset

        rsRelatorio.Open " Select Solicitacao, Analista, DataEntrega, HoraDistribuicao, DataAprovacao, Aprovador, DataAtraso from Distribuicao " & _
                         " Where DataEntrega BETWEEN " & "#" & DataInicial.Value & "#" & "and" & "#" & DataFinal.Value & "#" & "Order by Solicitacao", conn
                                           
    Set objExcel = CreateObject("Excel.application")

    With objExcel
        .Visible = True
        .Workbooks.Add

        .Cells(2, 1).CopyFromRecordset rsRelatorio
        .Cells(1, 1).Formula = "Solicitação"
        .Cells(1, 2).Formula = "Analista"
        .Cells(1, 3).Formula = "Data de entrega"
        .Cells(1, 4).Formula = "Hora de distribuição"
        .Cells(1, 5).Formula = "Data de aprovação"
        .Cells(1, 6).Formula = "Aprovador"
        .Cells(1, 7).Formula = "Data de atraso"


        .Range("A:G").Borders.Color = RGB(1, 1, 1)
        .Columns("A:AY").EntireColumn.AutoFit
        '.Range("A:A").Select
        .Selection.NumberFormat = "0"
    End With
    
End Sub

bem mais simples ira te ajudar abraços

USUARIO.EXCLUIDOS 31/08/2007 13:52:52
#233613

LOCOBOY

Muito obrigado era isso mesmo que eu queria, muito mais facil e rápido, rsrsrs.

USUARIO.EXCLUIDOS 31/08/2007 15:50:47
#233643

kkkkkkkkk
Abraços velho fecha o topico
:D

Página única

Tópico encerrado , respostas não são mais permitidas

Voltar