Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Configurar o código...
 
Notifications
Clear all

Configurar o código de exportação de dados vba to Nova Plan

 
2024 - VBA & Macros
11 Posts
2 Usuários
0 Reactions
1,668 Visualizações
RSS
 Lorenzon
(@lorenzon)
Posts: 355
Honorable Member
Topic starter
 

Pessoal, bom dia!

Utilizo o código abaixo para exportar os dados da listview para um novo Workbook, criado automaticamente pelo próprio código. Isso funciona bem, mas, para as colunas de Vencimento e Previsto, é necessário que eu ponha Cdate.

A pergunta é: onde colocá-lo?

Private Sub image39_Click()

Dim xlApp As Object, xlWb As Object, xlWs As Object
Dim ROW As Integer, Col As Integer
Dim X

Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Add
Set xlWs = xlWb.Worksheets(1)

xlApp.Visible = True
xlApp.UserControl = True

xlWs.Cells(1, 1).Value = "ID"
xlWs.Columns(1).ColumnWidth = 5
xlWs.Cells(1, 2).Value = "Descrição do Item"
xlWs.Columns(2).ColumnWidth = 60
xlWs.Cells(1, 3).Value = "Centro de Custo"
xlWs.Columns(3).ColumnWidth = 30
xlWs.Cells(1, 4).Value = "Conta Razão"
xlWs.Columns(4).ColumnWidth = 30
xlWs.Cells(1, 5).Value = "Tipo"
xlWs.Columns(5).ColumnWidth = 10
xlWs.Cells(1, 6).Value = "Valor"
xlWs.Columns(6).ColumnWidth = 10
xlWs.Cells(1, 7).Value = "Vencimento"
xlWs.Columns(7).ColumnWidth = 13
xlWs.Cells(1, 8).Value = "Previsto"
xlWs.Columns(8).ColumnWidth = 13
xlWs.Cells(1, 9).Value = "Pagamento"
xlWs.Columns(9).ColumnWidth = 13
xlWs.Cells(1, 10).Value = "Situação"
xlWs.Columns(10).ColumnWidth = 13
xlWs.Cells(1, 11).Value = "Cliente"
xlWs.Columns(11).ColumnWidth = 60

xlWs.Columns(12).ColumnWidth = 0

xlWs.Columns(13).ColumnWidth = 0

xlWs.Columns(14).ColumnWidth = 0

xlWs.Columns(15).ColumnWidth = 0
For X = 1 To 11
xlWs.Columns(X).HorizontalAlignment = xlLeft
Next

xlWs.Rows(1).RowHeight = 18
xlWs.Rows(1).Font.Bold = True
xlWs.Range("A1:k65000").Font.Size = 11

For ROW = 2 To lslista.ListItems.Count + 1
For Col = 1 To lslista.ColumnHeaders.Count
If Col = 1 Then
xlWs.Cells(ROW, Col).Value = lslista.ListItems(ROW - 1).Text
Else
xlWs.Cells(ROW, Col).Value = lslista.ListItems(ROW - 1).SubItems(Col - 1)
End If
Next
Next

MsgBox "Exportação realizada com Sucesso!", vbInformation, "Exportação de Dados"

End Sub

 
Postado : 06/10/2014 4:54 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Isso ocorre guando tu visualiza os dados na ListView ou após exportar para o arquivo?

Att

 
Postado : 06/10/2014 7:06 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Duas mudanças...
1) não mudar o tamanho da fonte como vc está mudando
2) identificar no meio do loop, quais as colunas de data, que vi no inicio do código, e aplicar o cdate para elas...

Segue:

xlWs.Rows(1).RowHeight = 18
xlWs.Rows(1).Font.Bold = True
'xlWs.Range("A1:k65000").Font.Size = 11 '(isso faz seu arquivo ficar grande, use a linha abaixo
xlWs.Range("A:K").Font.Size = 11 

For ROW = 2 To lslista.ListItems.Count + 1
For Col = 1 To lslista.ColumnHeaders.Count
If Col = 1 Then
xlWs.Cells(ROW, Col).Value = lslista.ListItems(ROW - 1).Text
ElseIf Col = 7 or col = 8 Then
xlWs.Cells(ROW, Col).Value = vba.cdate(lslista.ListItems(ROW - 1).Text)
Else
xlWs.Cells(ROW, Col).Value = lslista.ListItems(ROW - 1).SubItems(Col - 1)
End If
Next
Next
 
Postado : 06/10/2014 7:09 am
 Lorenzon
(@lorenzon)
Posts: 355
Honorable Member
Topic starter
 

Alexandre,

É da listview para um novo workbook.

Fernando,

Não obtive sucesso ao utilizar esses códigos. A exportação, depois da utilização do código sugestionado por você, apresentou-me datas inexistentes na listview, do tipo, 03/10/1901.

 
Postado : 06/10/2014 12:19 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Se eu entendi bem, creio que há forma não muito atraente, de na guia (nas colunas afetadas - Via VBA), mudar a formatação, já que os dados serão exportados.

Att

 
Postado : 06/10/2014 12:24 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Entao use assim:

xlWs.Cells(ROW, Col).Value = iif(isdate(lslista.ListItems(ROW - 1).Text), vba.cdate(lslista.ListItems(ROW - 1).Text),lslista.ListItems(ROW - 1).Text)
 
Postado : 06/10/2014 12:36 pm
 Lorenzon
(@lorenzon)
Posts: 355
Honorable Member
Topic starter
 

Sem sucesso1 Utilizando-o, faz com que, nas colunas referentes as datas, repete-se os dados contidos na coluna zero.

 
Postado : 06/10/2014 1:48 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Cara, publica o modelo (não esqueça de compactá-lo.... )....

 
Postado : 06/10/2014 4:47 pm
 Lorenzon
(@lorenzon)
Posts: 355
Honorable Member
Topic starter
 

Fernando,

Fica difícil para publicá-lo, uma vez que o mesmo tem 6 megas!

=/

 
Postado : 08/10/2014 10:43 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Veja algumas maneiras...

Use um site de hospedagem e poste, salve em formato binário, importe somente o formulário para um arquivo em branco ou com poucos dados etc...

Att

 
Postado : 08/10/2014 11:03 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Use DropBox ou OneDrive...
ou manda no meu email...

[email protected]

 
Postado : 08/10/2014 11:17 am
Forum Jump:
  Tópico Anterior
Próximo Tópico