msflexgrid数据导出到excel问题

Question

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

Answer 1

"加 入 打 印 命 令 按 钮(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"
在网上查到的,我试了!你可以看看对你是否有帮助!

Answer 2

谢谢楼上的老兄!我的代码好象是一样的,原来我也用过,产生了很好的报表,现在主要是到了excel后就产生了回车符,问题是如何去除回车符!

Answer 3

'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

Answer 4

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

Answer 5

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