msflexgrid数据导出到excel问题

achun0313 2004-09-02 04:40:47
在msflexgrid数据导出到excel表时,出现n多回车,查过msflexgrid的数据没有问题也没有回车.以前从来没有出现这种情况.请问如何解决啊!!痛苦啊
...全文
245 点赞 收藏 5
写回复
5 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
starsoulxp 2004-09-02
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
回复
starsoulxp 2004-09-02
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 2004-09-02
'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
回复
achun0313 2004-09-02
谢谢楼上的老兄!

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

现在主要是到了excel后就产生了回车符,问题是如何去除回车符!
回复
yyang326 2004-09-02
"加 入 打 印 命 令 按 钮(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"
在网上查到的,我试了!你可以看看对你是否有帮助!
回复
相关推荐
发帖
VB基础类
创建于2007-09-28

7489

社区成员

VB 基础类
申请成为版主
帖子事件
创建了帖子
2004-09-02 04:40
社区公告
暂无公告