Problema Exportando a Excel

[gasafonso]

Tengo este codigo para exportar el contenido de un msflexigrid a excel, pero en un principio me lo exportaba y ahoro no se que toque que no me lo exporta

Código vb:

Public Function cierreaExcel(grilla As MSFlexGrid) As Boolean
    Dim i As Long, j As Long
    Dim objExcel As Object
    Dim objWorkbook As Object
    On Error Resume Next ' por si se cierra Excel antes de cargar los datos
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    Set objWorkbook = objExcel.Workbooks.Add
    For i = 0 To grilla.Rows - 1
       grilla.Row = i
        For j = 1 To grilla.Cols - 1
            grilla.Col = j
            If i = 0 Then
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Interior.Color = &H80C0FF
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Font.Bold = True
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Value = grilla.text
            Else
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Style = "Comma"
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).NumberFormat = "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).NumberFormat = "_-* #,##0_-"
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Interior.Color = &HC0FFFF
                objWorkbook.ActiveSheet.Cells(i + 1, j + 1).Value = grilla.text
            End If
        Next
    Next
       
    objExcel.Cells.Select
    objExcel.Selection.EntireColumn.AutoFit    ' Ancho de columna
    objWorkbook.ActiveSheet.Range("b1:i59").Borders().LineStyle = 1
    objWorkbook.ActiveSheet.Range("A59:i59").Font.Bold = True
    'objWorkbook.ActiveSheet.Columns("K:K").ColumnWidth = 13.71
    objExcel.Range("b1").Select
    objExcel.Visible = True
    
    objExcel.ActiveWindow.SelectedSheets.PrintPreview ' Previsualizar informe
    Set objWorkbook = Nothing
    Set objExcel = Nothing
End Function
 

gracias

[SalomonSab]

Haber si te sirve este codigo para exportar el contenido de una grilla a Excel

En un Modulo coloca este codigo tal cual

Código:

Public Sub ExportarGrid(Grid As MSHFlexGrid, FileName As String, FileType)
Dim i As Long
Dim j As Long

On Error GoTo ErrHandler

    'Let's put a HourGlass pointer for the mouse
    Screen.MousePointer = vbHourglass

    If FileType = 1 Then 'Exporta a excel
        'Gimme the workbook
        Dim wkbNew As Excel.Workbook
        'Gimme the worksheet for the workbook
        Dim wkbSheet As Excel.Worksheet
        'Gimme the range for the worksheet
        Dim Rng As Excel.Range

        'Does the file exist?
        If Dir(FileName) <> "" Then
            'Kill it boy!
            Kill FileName
        End If

On Error GoTo CreateNew_Err

    'Let's create the workbook kid!
    Set wkbNew = Workbooks.Add
    wkbNew.SaveAs FileName

    'Add a WorkPage
    Set wkbSheet = wkbNew.Worksheets(1)

    'Set the values in the range
    Set Rng = wkbSheet.Range("A1:" + Chr(Grid.Cols + 64) + CStr(Grid.Rows))
        For j = 0 To Grid.Cols - 1
            For i = 0 To Grid.Rows - 1
                If Val(j) <> 3 Then
                    Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = Grid.TextMatrix(i, j)
                    Else
                    Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = Val(Replace(Grid.TextMatrix(i, j), ",", "."))
                End If
            Next
        Next

    'Close and save the file
    wkbNew.Close True

GoTo NoErrors
CreateNew_Err:
    'Stop the show!
    wkbNew.Close False
    Set wkbNew = Nothing
    Resume ErrHandler

    Else 'Export to text
    Dim Fs As Variant
    Dim A As Variant

    'I know, the File # sounds smarter, but, I like weird things :) !
On Error GoTo ErrHandler
    Set Fs = CreateObject("Scripting.FileSystemObject")
    Set A = Fs.CreateTextFile(FileName, True)
    Dim Line As String
        For j = 0 To Grid.Rows - 1
            For i = 0 To Grid.Cols - 1
                Line = Line + Grid.TextMatrix(i, j) + vbTab
            Next
            A.WriteLine (Line)
            Line = ""
        Next
    A.Close

End If

NoErrors:
    'Gimme the default mouse pointer dude!
    Screen.MousePointer = vbDefault
    MsgBox "Los datos fueron exportados Correctamente", vbOKOnly, "Finalizado"
    Exit Sub

ErrHandler:
    'Gimme the default mouse pointer dude!
    Screen.MousePointer = vbDefault
    MsgBox "¡Vaya!, ¡Vaya!, ¡Vaya! lo lamento hoy ¡No puedo exportar Tu fichero!", vbOKOnly, "Error"
    Exit Sub
End Sub

Y lo llamas desde un Command Button asi:

Código:

Private Sub CmdExportar_Click()
On Error GoTo ErrHandler
    CD.Filter = "Excel File(*.xls)|*.xls|Text File (*.txt)|*.txt"
    CD.FilterIndex = 1
    CD.ShowSave
    ExportarGrid NombredeTuGrilla, CD.FileName, CD.FilterIndex
ErrHandler:
End Sub

sobra decir que tienes que agregar el componente Commondialog que en mi caso lo he llamado CD

Espero te sirva

[gasafonso]

Hola SalomonSab, no me lo exporta a excel, acordate que no es MSHFLEXIGRID es MSFLEXIGRID .

Me deja el cursor con el reloj de arena y no me lo exporta

[SalomonSab]

y si cambias esta linea

Código:

Public Sub ExportarGrid(Grid As MSFlexGrid, FileName As String, FileType)

[culd]

Seguis con el copy/paste

Que barbaro... Estos chicos che...

[gasafonso]

No, le cambie esa linea y no me responde.


Culd !!! y como tengo que hacer ?

[culd]

Iniciado por gasafonso

Culd !!! y como tengo que hacer ?

Sobre que estas haciendo copy/paste de codigo que encontraste en internet, por lo menos usa la cabeza y lee linea por linea para encontrar el problema, o por lo menos identificar como funciona la sub accion y tratar de mejorarla. POR LO MENOS

Agota toda tu cabeza primero.

[gasafonso]

Son cosas que yo nunca habia usado, y me lo pasron en otro foro, pero tuve que reinstalar de nuevo el VB 6 y dejo de funcionar


ACORDATE CULD QUE SOY PRINCIPIANTE ( AUTODIDACTA)

[SalomonSab]

Entonces aplica el proceso paso a paso posicionate en la linea donde haces click para hacer la exportación y presiona F9 corres tu programa y cuando haces click te manda a ese proceso y te vas con F8 hasta llegar donde se detiene y ahi te dara cuenta cual seria el problema

[gasafonso]

No ya probe linea por linea y no pasa nada.

Tiene que ser algo de algun driver o configurarcion por que antes me lo hacia perfecto