Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: zxs23 en Agosto 18, 2014, 05:52:44 pm
-
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
-
Yo hago esto:
Dim oExcel As Object, wb As Object, hoja As Object
Set oExcel = CreateObject("Excel.Application")
Set wb = oExcel.Workbooks.Add
Set hoja = wb.Worksheets.Add
'... Mientras relleno los datos en un bucle...
hoja.cells(iFila, iColumna).Value = .TextMatrix(Fila, Columna) 'Texto
hoja.cells(iFila, iColumna).Select ' A partir de aca empiezo a dar formato
oExcel.ActiveCell.Interior.color = cBackColor ' Color de fondo
oExcel.Selection.Style = "Currency" ' Formato moneda
Para saber que codigo corresponde a cada formato. Graba una macro en excel con LO MAS MINIMO de modificaciones y luego en el dialogo de macros pones modificar y ahí aparecera.
-
Hola. gracias por responder ya coloque formato al rango que necesitaba, pero tengo un inconveniente porque para el titulo utilizo .merge para conbinar varias celdas.
Si le coloco el merge para combinar las celdas que ocuparan el titulo le aplica formato currency a todo el rango osea desde A1 hasta D1
Hoja.range("A1:D1").Merge
Hoja.range("A1").Font.Bold = True
Si le quito el .merge se soluciona y solo le coloca formato al rango A1:A20 que es la unica columna a la que quiero pasarle formato.
Excel.range("A1:A20").Select
Excel.selection.Style = "currency"
-
No entiendo como tienes los datos (creo que A1:D1 son titulos no? ). Tambien puedes intentar por separado
Hoja.range("A1:D1").Merge
Hoja.range("A1").Font.Bold = True
Excel.range("A1").Select
Excel.selection.Style = "currency"
Excel.range("A2:A20").Select
Excel.selection.Style = "currency"
-
Hola gracias ya vi mi error, tambien le estaba mandando el currency a A1 que es donde esta el titulo y deberia ser a partir de A2, soluciona el tema, saludos