Como podria colocar formato a las celdas de una fila entera o en un rango especifico A1:A20 despues de haber exportado, esta es la funcion actual, lo intente con unos codigos que googlé como objetoExcel.selection.NumberFormat = "Formato" y no manda error ni nada pero tampoco le hace nada, nose donde podria estar el fallo.
Public Function Exportar_Excel(rec As Recordset) As Boolean
On Error GoTo errSub
Dim Excel As Object
Dim Libro As Object
Dim Hoja As Object
Dim arrData As Variant
Dim iRec As Long
Dim iCol As Integer
Dim iRow As Integer
'Me.Enabled = False
Screen.MousePointer = 11
' -- Crear los objetos para utilizar el Excel
Set Excel = CreateObject("Excel.Application")
Set Libro = Excel.Workbooks.Add
' -- Hacer referencia a la hoja
Set Hoja = Libro.Worksheets(1)
Excel.Visible = True: Excel.UserControl = True
iCol = rec.Fields.Count
For iCol = 1 To rec.Fields.Count
Hoja.Cells(1, iCol).Value = rec.Fields(iCol - 1).Name
Next
If Val(Mid(Excel.Version, 1, InStr(1, Excel.Version, ".") - 1)) > 8 Then
Hoja.Cells(2, 1).CopyFromRecordset rec
Else
arrData = rec.GetRows
iRec = UBound(arrData, 2) + 1
For iCol = 0 To rec.Fields.Count - 1
For iRow = 0 To iRec - 1
If IsDate(arrData(iCol, iRow)) Then
arrData(iCol, iRow) = Format(arrData(iCol, iRow))
ElseIf IsArray(arrData(iCol, iRow)) Then
arrData(iCol, iRow) = "Array Field"
End If
Next iRow
Next iCol
' -- Traspasa los datos a la hoja de Excel
Hoja.Cells(2, 1).Resize(iRec, rec.Fields.Count).Value = GetData(arrData)
End If
Excel.Selection.CurrentRegion.Columns.AutoFit
Excel.Selection.CurrentRegion.Rows.AutoFit
'Hoja.Name = ""
Libro.saveAs App.Path & "\libro"
'Libro.Close
' -- Elimina las referencias xls
Set Hoja = Nothing
Set Libro = Nothing
'Excel.quit
Set Excel = Nothing
Exportar_Excel = True
'Me.Enabled = True
Screen.MousePointer = 0
Exit Function
errSub:
MsgBox Err.Description, vbCritical, "Error"
Exportar_Excel = False
'Me.Enabled = True
Screen.MousePointer = 0
End Function
Private Function GetData(vValue As Variant) As Variant
Dim X As Long, Y As Long, xMax As Long, yMax As Long, T As Variant
xMax = UBound(vValue, 2): yMax = UBound(vValue, 1)
ReDim T(xMax, yMax)
For X = 0 To xMax
For Y = 0 To yMax
T(X, Y) = vValue(Y, X)
Next Y
Next X
GetData = T
End Function
