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