msflexgrid数据导出到excel问题

[achun0313]

在msflexgrid数据导出到excel表时,出现n多回车,查过msflexgrid的数据没有问题也没有回车.以前从来没有出现这种情况.请问如何解决啊!!痛苦啊

[yyang326]

"加 入 打 印 命 令 按 钮(command1)，CAPTION 设 为" 生 成EXCEL 表格"， 写 入 下 面 代 码
Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'Set xlBook = xlApp.Workbooks.Add
'On Error Resume Next
Set xlBook = xlApp.Workbooks.Add ' Open("d:\text2.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Cells(2, 1) = "i"
For i = 0 To MSF1.row
MSF1.row = i
For j = 0 To 15
MSF1.col = j

If IsNull(MSF1.Text) = False Then
xlSheet.Cells(i + 5, j + 1) = MSF1.Text
End If
Next j
Next i
Exit Sub
End Sub"
在网上查到的,我试了!你可以看看对你是否有帮助!

[achun0313]

谢谢楼上的老兄!

我的代码好象是一样的,原来我也用过,产生了很好的报表,

现在主要是到了excel后就产生了回车符,问题是如何去除回车符!

[starsoulxp]

'MSHFlexGrid控件的导出
Public Function FlexExport(ByVal Flex1 As MSHFlexGrid, ByVal CommonDialog1 As CommonDialog)
mvarVersion = vbLBV5
Dim SaveFilePath As String
Dim EXEString As String
Dim i As Integer, j As Integer
Dim InsertAmount As Integer
Dim WS As DAO.Workspace
Dim DB As DAO.Database
Dim TABL As DAO.TableDef
Dim RS As DAO.Recordset
'On Error GoTo err_handle
On Error Resume Next
With CommonDialog1
.CancelError = False
.Filter = "Excel文件(*.xls)|*.xls"
.DialogTitle = "将数据导出到Excel表(5.0)"
.ShowOpen
If Trim(.FileName) = "" Then
Exit Function
End If

SaveFilePath = .FileName
End With

Set WS = DBEngine.CreateWorkspace("WS", "Admin", "", dbUseJet)
Kill App.Path & "\report\FlexToExcel.mdb"
Set DB = WS.CreateDatabase(App.Path & "\report\FlexToExcel.mdb", dbLangGeneral, dbEncrypt)
Set TABL = DB.CreateTableDef("Excel")
For i = 1 To Flex1.Cols - 1
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, i), dbText, 250)
Next i

DB.TableDefs.Append TABL
Set RS = DB.OpenRecordset("Excel")
If Flex1.Rows > 1 Then
InsertAmount = Flex1.Cols - 1
For i = 1 To Flex1.Rows - 1
RS.AddNew
For j = 1 To InsertAmount - 1
If Flex1.TextMatrix(i, j) <> "" Then
RS.Fields(j - 1) = Flex1.TextMatrix(i, j)
ElseIf Flex1.TextMatrix(i, j) = "" Then
RS.Fields(j - 1) = "//"
End If
Next j
RS.Update
Next i
End If
EXEString = "select * into [Excel " & Format(CStr(mvarVersion), "0.0") & ";database=" & SaveFilePath & "].LBExcel from Excel"
DB.Execute EXEString
RS.Close
DB.Close
WS.Close
Kill App.Path & "\report\FlexToExcel.mdb"
MsgBox "导出数据到Excel表成功!", vbInformation, "提示"
Exit Function
err_handle:
Select Case Err
Case 53:
Resume Next
End Select
End Function

[starsoulxp]

Public Sub OutDataToExcel(Flex As MSHFlexGrid) '导出至Excel
Dim s As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo Ert
Me.MousePointer = 11
Dim Excelapp As Excel.Application
Set Excelapp = New Excel.Application
On Error Resume Next
DoEvents
Excelapp.SheetsInNewWorkbook = 1
Excelapp.Workbooks.Add
Excelapp.ActiveSheet.Cells(1, 3) = s
Excelapp.Range("C1").Select
Excelapp.Selection.Font.FontStyle = "Bold"
Excelapp.Selection.Font.Size = 16
With Flex
k = .Rows
For i = 0 To k - 1
For j = 0 To .Cols - 1
DoEvents
Excelapp.ActiveSheet.Cells(3 + i, j + 1) = "'" & .TextMatrix(i, j)
Next j
Next i
End With
Me.MousePointer = 0
Excelapp.Visible = True
Excelapp.Sheets.PrintPreview '打印预览
Ert:
If Not (Excelapp Is Nothing) Then
Excelapp.Quit
End If
End Sub

[starsoulxp]

Sub copyflexdatatoexcel(flex As MSFlexGrid)
On Error GoTo handle
Dim excelapp As Excel.Application
Dim excelworkbood As Excel.Workbook
Dim Rows, Cols As Integer
Dim iRow, hCol, iCol As Integer
Dim New_Col As Boolean

If flex.Rows <= 1 Then
MsgBox "没有数据！", vbInformation, App.Title
Exit Sub
End If

Set excelapp = CreateObject("Excel.application")
Set excelworkbood = excelapp.Workbooks.Add

Dim New_Column As Boolean
With flex
Rows = .Rows
Cols = .Cols
iRow = 0
iCol = 1
For hCol = 0 To Cols - 1
For iRow = 1 To Rows
excelapp.Cells(iRow, iCol).Value = .TextMatrix(iRow - 1, hCol)
Next iRow
iCol = iCol + 1
Next hCol
End With

excelapp.Rows(1).Font.Bold = True
excelapp.Cells.Select
excelapp.Columns.AutoFit
excelapp.Cells(1, 1).Select
excelapp.Application.Visible = True

Set excelworkbood = Nothing
Set excelapp = Nothing
flex.SetFocus
MsgBox "数据已经导出到Excel中。", vbInformation, "成功"
Exit Sub
handle:
MsgBox "数据导出失败！", vbCritical, "警告"

End Sub