Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
formatar coluna em ...
 
Notifications
Clear all

formatar coluna em data, planilha exportada.

 
2024 - VBA & Macros
6 Posts
2 Usuários
0 Reactions
1,458 Visualizações
RSS
 ifahidalgo
(@ifahidalgo)
Posts: 16
Active Member
Topic starter
 

Senhores

Bom dia

Estou precisando do Help dos senhores
tenho um formulario onde faço um filtro em um listwiew e com esse resultado tem um botão que exporta para uma planilha em excel sendo que em algumas celulas de data os meses entram como dia e o dia entram como mês. tipo datas 01 a 12 são gravadas como mm/dd/aaaa e de 13 a 31 dd/mm/aaaa.
segue o codigo utilizado para a exportação
______________________________________
Private Sub botao_ExportarRelatorio_Click()
Dim xlApp, xlWb, xlWs As Object
Dim Row, Col, UltimaLinha

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

xlApp.Visible = True
xlApp.UserControl = True

xlWs.Columns(1).ColumnWidth = 15
xlWs.Columns(2).ColumnWidth = 10
xlWs.Columns(3).ColumnWidth = 10
xlWs.Columns(4).ColumnWidth = 20
xlWs.Columns(5).ColumnWidth = 35
xlWs.Columns(6).ColumnWidth = 45
xlWs.Columns(7).ColumnWidth = 40
xlWs.Columns(8).ColumnWidth = 12
xlWs.Columns(9).ColumnWidth = 12
xlWs.Columns(10).ColumnWidth = 12
xlWs.Columns(11).ColumnWidth = 45
xlWs.Columns(12).ColumnWidth = 15

xlWs.Rows(1).RowHeight = 80
xlWs.Rows(2).RowHeight = 30

xlWs.Range("A2:L2").Font.Size = 10
xlWs.Range("A3:L32000").Font.Size = 9

'Todo o texto alinhado e centralizado
With xlWs.Range("A1:L32000")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'Define parâmetros sobre Fonte no intervalo de células A3:K3 e adiciona AutoFiltro
With xlWs.Range("A3:L3")
.Font.Bold = True
.AutoFilter
End With

'Texto alinhado à esquerda
With xlWs.Range("E2:E32000")
.HorizontalAlignment = xlLeft
End With

'Texto alinhado à direita
With xlWs.Range("J2:L32000")
.HorizontalAlignment = xlRight
End With

'Mescla intervalo de células A2:K2
xlWs.Range("A2:L2").Merge

'Copia Imagem LOGO
Sheets("Inicio").Shapes("LOGO").Select
Selection.Copy
xlWs.Paste

'Cola na nova planilha
With xlWs.Shapes("LOGO")
.Height = 80
.Width = 1225
End With

'Define parâmetros sobre Fonte no intervalo de células A2:K2
With xlWs.Range("A2:L2").Font
.FontStyle = "Negrito"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With

'Define efeito gradiente no intervalo de células A2:K2
With xlWs.Range("A2:L2").Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 135
.Gradient.ColorStops.Clear
End With
'Define efeito gradiente no intervalo de células A2:K2
With xlWs.Range("A2:L2").Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.250984221930601
End With
'Define efeito gradiente no intervalo de células A2:K2
With xlWs.Range("A2:L2").Interior.Gradient.ColorStops.Add(0.5)
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
End With
'Define efeito gradiente no intervalo de células A2:K2
With xlWs.Range("A2:L2").Interior.Gradient.ColorStops.Add(1)
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.250984221930601
End With

'Atribui texto ao intervalo de células A2:K2
xlWs.Cells(2, 1).Value = "RELATÓRIO DE DIÁRIAS"
'Preenche cabeçalho
xlWs.Cells(3, 1).Value = "DATA FORMAÇÃO PROCESSO"
xlWs.Cells(3, 2).Value = "ANO REFERÊNCIA"
xlWs.Cells(3, 3).Value = "MÊS REFERÊNCIA"
xlWs.Cells(3, 4).Value = "PROCESSO"
xlWs.Cells(3, 5).Value = "SETOR DEMANDANTE"
xlWs.Cells(3, 6).Value = "SERVIDOR"
xlWs.Cells(3, 7).Value = "CIDADE / DESTINO"
xlWs.Cells(3, 8).Value = "DATA IDA"
xlWs.Cells(3, 9).Value = "DATA VOLTA"
xlWs.Cells(3, 10).Value = "QUANTIDADE DIÁRIA"
xlWs.Cells(3, 11).Value = "ASSUNTO"
xlWs.Cells(3, 12).Value = "VALOR DIÁRIA"

For Row = 2 To ListView_Resultados.ListItems.Count + 1
For Col = 1 To ListView_Resultados.ColumnHeaders.Count
If Col = 1 Then
xlWs.Cells(Row + 2, Col).Value = ListView_Resultados.ListItems(Row - 1).Text

Else
xlWs.Cells(Row + 2, Col).Value = ListView_Resultados.ListItems(Row - 1).SubItems(Col - 1)
End If
Next
Next Row

xlWs.Columns("M:XFD").Hidden = True
xlWb.Sheets("Plan1").Name = "Relatorio"
xlWb.Sheets("Plan2").Delete
xlWb.Sheets("Plan3").Delete
End Sub

 
Postado : 26/03/2015 9:45 am
 ifahidalgo
(@ifahidalgo)
Posts: 16
Active Member
Topic starter
 

alguma ajuda

 
Postado : 30/03/2015 10:50 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Creio que não obteve resposta ainda, pela falta do modelo/exemplo de planilha. Basicamente o problema é que o listview por padrão retorna seus dados como string/Texto, assim ao receber o valor de data o excel "tenta" converte-lo ao seu valor "similar"; como o padrão interno do VBA aparentemente e o Americano, data é primeiramente entendido como Mês Dia Ano.
Assim é necessário informar qual o padrão a ser utilizado. Como utiliza um loop para retornar as infomrações à planilha, fica um tanto mais complicado.
Para as colunas data é necessario formata-las.
Creio que sejam as colunas 8 e 9 (caso não seja terá que adaptar)
experimente utilizar/alterar o loop conforme abaixo:

For Row = 2 To ListView_Resultados.ListItems.Count + 1
    For col = 1 To ListView_Resultados.ColumnHeaders.Count
        If col = 1 Then
            xlWs.Cells(Row + 2, col).Value = ListView_Resultados.ListItems(Row - 1).Text
        ElseIf col = 8 Or col = 9 Then
            xlWs.Cells(Row + 2, col).Value = Format(ListView_Resultados.ListItems(Row - 1).SubItems(col - 1), "dd/mm/yyyy")
        Else
            xlWs.Cells(Row + 2, col).Value = ListView_Resultados.ListItems(Row - 1).SubItems(col - 1)
        End If
    Next
Next

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 30/03/2015 11:13 am
 ifahidalgo
(@ifahidalgo)
Posts: 16
Active Member
Topic starter
 

apliquei o código, mas quando exporta, continua com as datas menores que dia 12, são trocadas por mes/dia/ano, acima e igual a 13, ficam normal dia/mes/ano

 
Postado : 30/03/2015 12:34 pm
 ifahidalgo
(@ifahidalgo)
Posts: 16
Active Member
Topic starter
 

segue o arquivo.

 
Postado : 30/03/2015 12:41 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aparentemente você utiliza seu arquivo em um ambiente de 64 bits, então tenho um pouco de dificuldade em testar mas..
Como algumas datas estão em branco tambem e recomendado/necessario fazer o tratamento dessa possibilidade.
Então experimente:

For Row = 2 To ListView_Resultados.ListItems.Count + 1
    For Col = 1 To ListView_Resultados.ColumnHeaders.Count
        If Col = 1 Then
            If ListView_Resultados.ListItems(Row - 1).Text <> "" Then xlWs.Cells(Row + 2, Col).Value = CDate(Format(ListView_Resultados.ListItems(Row - 1).Text, "dd/mm/yyyy"))
        ElseIf Col = 8 Or Col = 9 Then
            If ListView_Resultados.ListItems(Row - 1).SubItems(Col - 1) <> "" Then xlWs.Cells(Row + 2, Col).Value = CDate(Format(ListView_Resultados.ListItems(Row - 1).SubItems(Col - 1), "dd/mm/yyyy"))
        Else
            xlWs.Cells(Row + 2, Col).Value = ListView_Resultados.ListItems(Row - 1).SubItems(Col - 1)
        End If
    Next
Next Row

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 30/03/2015 1:16 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico