Exportar Grilla MSHflexgrid a Excel-97 (no excel 2

Hola, que tal... Espero que estes bien... Y que este año sea mejor para todos......
bueno quisiera hacerte la sgte consulta :
Necesito saber como Exportar una Grilla (MSHflexgrid) a Excel-97 pero NO a Excel-2000 ya que tengo una rutina para esto...pero no me sirve para Excel-97 y no he podido encontrar la forma............
desde ya gracias...........

1 Respuesta

Respuesta
Quizas esta rutina te pueda ayudar:
----------------------
Private Sub CmdExport_Click()
'This code exports a recordset to an excel spreadsheet
Dim x
Dim xlApp As Excel.Application
Dim xlBook As Workbook
Dim xl As Excel.Worksheet
Dim icols
Dim expDB As Database
Dim rs As Recordset
Dim FldCount As Integer
Dim rsCount As Integer
Dim i, k, c, r
x = MsgBox("This function will export the current records in the DBGrid to an Excel sheet, " & _
"If you do not have Excel an error will occur, do wish to continue?", vbYesNo + vbQuestion, "Export Data?")
If x = vbNo Then Exit Sub
If IsNull(tmpData.Recordset) Then GoTo NoRS
Screen.MousePointer = vbHourglass
'Access Your recordset here it is from as
'Data control, it does not maatter where it
'comes from.
Set rs = lstdb.OpenRecordset(tmpData.RecordSource, dbOpenSnapshot)
'Declare application
Set xlApp = CreateObject("Excel.Application")
'Declare Workbook
Set xlBook = xlApp.Workbooks.Add(xlWBATWorksheet)
'Identify worksheet
Set xl = xlBook.Worksheets(1)
'Below this code determines the number of columns then
'labels each column with the appropriate field name.
'This code can be found in the 'CopyFromRecordSet' function
'of the Excel Object.
FldCount = rs.Fields.Count - 1
'Excel Column counts are kept seperate as fields may be skipped
c = 1
For icols = 0 To rs.Fields.Count - 1
'If the field is a system field then it skips it.
If rs.Fields(icols).Name Like "s_" & Chr(42) Then GoTo SkipName
xl.Cells(1, c).Value = rs.Fields(icols).Name
c = c + 1
SkipName:
Next
xl.Range(xl.Cells(1, 1), xl.Cells(1, rs.Fields.Count)).Font.Bold = True
With rs
.MoveLast
.MoveFirst
rsCount = .RecordCount - 1
r = 2
Me.Height = 5970
'Here I have a statusbar on my form
Bar1.Min = 0
Bar1.Max = rsCount
lblExport.Visible = True
Bar1.Visible = True
'4 loops are being performed at once here.
'Loop 'k' loops through the rows of records and
'with each row 'r' for the Excel sheet.
'Inside this loop is another nested loop.
'Loop 'i' is looping through the Fields and along
'with i 'c' is moving through the columns.
'As mentioned above the reason for seperate counts
'between the recordset and Excel sheet are due to
'skipping system fields.
For k = 0 To rsCount
c = 1
For i = 0 To FldCount
If rs.Fields(i).Name Like "s_" & Chr(42) Then GoTo SkipField
xl.Cells(r, c).Value = rs.Fields(i).Value
c = c + 1
SkipField:
Next 'i
r = r + 1
.MoveNext
Bar1.Value = k
Next 'k
End With
'After loop is complete, show the sheet
xl.Visible = xlSheetVisible
xlApp.Visible = True
Bar1.Visible = False
lblExport.Visible = False
Me.Height = 5265
xlApp.Quit
Set xl = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set rs = Nothing
Screen.MousePointer = vbDefault
Exit Sub
NoRS:
Screen.MousePointer = vbDefault
MsgBox "No Active recordset detected"
Exit Sub
Exp_Err:
Screen.MousePointer = vbDefault
MsgBox Err.Number & ": " & Err.Description
Resume Next
End Sub
------------------------
Saludos
Roberto Alvarado
Cartagena - Colombia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas