Visual Basic - Problema con fecha al exportar a Excel

Function Exportar_Spread_Excel(oSpread As vaSpread, Optional bWithHead As Boolean = False, Optional bAllColumns As Boolean = True, Optional bExcel_is_Closed As Boolean = True, Optional Excel As Object, Optional ExcelWBk As Excel.Workbook, Optional ExcelWS As Excel.Worksheet, Optional DesdeFila As Integer = 0)

Dim iMouse%, iCol%, sCol$, iRows&, I%

Dim CeldaPaste$, sfmt$

On Local Error GoTo Error_Excel

iMouse% = Screen.MousePointer

Screen.MousePointer = 11

Call Globales.Barra_Progreso(0, True)

Call Globales.Barra_Progreso(oSpread.MaxCols + 10, False)

If bExcel_is_Closed Then

Set Excel = CreateObject("Excel.Application") 'Create Excel Object.

Set ExcelWBk = Excel.Workbooks.Add 'Add this Workbook to Excel.

Set ExcelWS = ExcelWBk.Worksheets(1) ' Add this sheet to this Workbook

End If

'-- Copiando a portapapeles

Call Globales.Barra_Progreso(1)

Clipboard.Clear

oSpread.Row = 1

oSpread.Col = 1

oSpread.Row2 = oSpread.MaxRows

oSpread.Col2 = oSpread.MaxCols

Clipboard.SetText oSpread.Clip

'-- formateo Worksheet todo como Texto

Call Globales.Barra_Progreso(2)

' ExcelWS.Cells.Select

' ExcelWS.Cells.NumberFormat = "general"

' ExcelWS.Cells.NumberFormatLocal = "@"

'-- Copiando a Excel

Call Globales.Barra_Progreso(3)

ExcelWS.Columns("L:L").NumberFormatLocal = "dd/mm/yyyy"

ExcelWS.Range("M:M").NumberFormatLocal = "dd/mm/yyyy"

ExcelWS.Range("N:N").NumberFormatLocal = "dd/mm/yyyy"

CeldaPaste = "A" & CStr((1 + DesdeFila))

ExcelWS.Range(CeldaPaste).Select

ExcelWS.Paste

iRows = oSpread.MaxRows + DesdeFila + 5

'iRows = oSpread.MaxRows

For iCol = oSpread.MaxCols To 1 Step -1

Call Globales.Barra_Progreso(4)

'-- columna

oSpread.Col = iCol

sCol = ""

If iCol > 26 Then

sCol = Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Val(Left(CStr((iCol - 1) / 26), 1)), 1)

iCol = iCol - (Val(Left(CStr((iCol - 1) / 26), 1)) * 26)

End If

sCol = sCol & Mid("ABCDEFGHIJKLMNOPQRSTUVWXYZ", iCol, 1)

'Debug.Print iCol & vbTab & " -> " & sCol

iCol = oSpread.Col

'-- rango

CeldaPaste = sCol & CStr(2 + DesdeFila) & ":" & sCol & CStr(iRows)

'-- control

If oSpread.ColHidden And Not bAllColumns Then

ExcelWS.Columns(sCol & ":" & sCol).Delete

' ElseIf oSpread.CellType = CellTypeCurrency Or oSpread.CellType = CellTypeNumber Or oSpread.CellType = CellTypePercent Then

' If Not ExcelWS.Range(CeldaPaste).Find(".") Is Nothing Then

' ExcelWS.Range(CeldaPaste).Replace ".", ""

' End If

' If Not ExcelWS.Range(CeldaPaste).Find(".") Is Nothing Then

' ExcelWS.Range(CeldaPaste).Replace ",", "."

' End If

' For I = 0 To 9

' If Not ExcelWS.Range(CeldaPaste).Find(CStr(I)) Is Nothing Then

' ExcelWS.Range(CeldaPaste).Replace CStr(I), CStr(I)

' End If

' Next I

' If oSpread.CellType = CellTypeCurrency Then

' sfmt$ = String(oSpread.TypeCurrencyDecPlaces, "0")

' ElseIf oSpread.CellType = CellTypePercent Then

' sfmt$ = String(oSpread.TypePercentDecPlaces, "0")

' Else

' sfmt$ = String(oSpread.TypeNumberDecPlaces, "0")

' End If

' If sfmt$ = "" Then

' sfmt$ = "#.##0"

' Else

' sfmt$ = "#.##0," & sfmt$

' End If

' ExcelWS.Columns(sCol & ":" & sCol).NumberFormatLocal = sfmt$ & ";[Rojo]-" & sfmt$

'

' ElseIf oSpread.CellType = CellTypeDate Then

' ExcelWS.Columns(sCol & ":" & sCol).NumberFormatLocal = "dd/mm/yyyy"

'

' ElseIf oSpread.CellType = CellTypeStaticText Then

' sCol = sCol & ":" & sCol

' ExcelWS.Columns(sCol).NumberFormat = "General"

' ExcelWS.Columns(sCol).HorizontalAlignment = xlGeneral

' ExcelWS.Columns(sCol).VerticalAlignment = xlTop

' ExcelWS.Columns(sCol).WrapText = False

' ExcelWS.Columns(sCol).Orientation = 0

' ExcelWS.Columns(sCol).AddIndent = False

' ExcelWS.Columns(sCol).IndentLevel = 0

' ExcelWS.Columns(sCol).ShrinkToFit = False

' ExcelWS.Columns(sCol).ReadingOrder = xlContext

' ExcelWS.Columns(sCol).MergeCells = False

'

' End If

'-- Ajusta columnas muy anchas '-- 2009.06.03

ExcelWS.Columns(sCol).EntireColumn.AutoFit

'Debug.Print ExcelWS.Columns(sCol).ColumnWidth

If ExcelWS.Columns(sCol).ColumnWidth > 50 Then

ExcelWS.Columns(sCol).ColumnWidth = 50

End If

'iRows = iRows - 1

Next iCol

ExcelWS.Cells.Select

ExcelWS.Cells.EntireRow.AutoFit

ExcelWS.Range("A1").Select

'oSpread.ClearSelection

Excel.Visible = True

'SendKeys "^(v)", True

If bExcel_is_Closed Then

Set ExcelWS = Nothing

'Excel.Quit

Set ExcelWBk = Nothing

Set Excel = Nothing

End If

Screen.MousePointer = iMouse%

GoTo fin

Error_Excel:

MsgBox "Error al intentar exportar a Excel" & vbCrLf & vbCrLf & Err.Description & " Code:" & Err.Number, vbExclamation, "Exportando datos a Excel"

Screen.MousePointer = iMouse%

fin:

Call Globales.Barra_Progreso(6)

Beep

Call Globales.Barra_Progreso(10, True)

End Function