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...........
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