怎样把listview或msflexgrid中的数据导出到excel中？

2004-08-25 09:18:58 234 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

UWB学习——day4 总的来说，BPM-BPSK调制方案是一种利用脉冲位置和相位来编码信息的高效数字调制技术，特别适用于UWB通信系统，以实现高速数据传输和频谱效率。这种方式将时间和相位综合使用，从而提高了数据传输的容量。总之，超外差结构是一种接收器设计，通过将不同频率的信号转换到一个共同的中间频率来提高信号选择性和抗干扰性。超外差结构是一种用于接收器的电子电路设计，它的目标是从无线信号中提取有用的信息，比如音频、数据或图像。该芯片的接收机是超外差结构，所谓超外差结构一种基于频率转换的接收器架构，旨在提高信号选择性和抗干扰性。阅读详情

...全文

TCP报文 Flood攻击原理与防御方式 TCP交互过程中包含SYN、SYN-ACK、ACK、FIN和RST报文，这几类报文也可能会被攻击者利用，海量的攻击报文会导致被攻击目标系统资源耗尽、网络拥塞，无法正常提供服务。接下来我们介绍几种常见的Flood攻击的原理和防御方式。阅读详情

cbzdream

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

cbzdream 2004-08-25

打赏
举报

还有不？

pancult 2004-08-25

打赏
举报

Public Function ListviewExport(ByVal ListView1 As ListView, 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
'If ListView1.ColumnHeaders.Count <= 0 Then
' Exit Sub
'End If

Set WS = DBEngine.CreateWorkspace("WS", "Admin", "", dbUseJet)
Kill App.Path & "\report\listviewToExcel.mdb"
Set DB = WS.CreateDatabase(App.Path & "\report\listviewToExcel.mdb", dbLangGeneral, dbEncrypt)
Set TABL = DB.CreateTableDef("Excel")
For i = 1 To ListView1.ColumnHeaders.Count
TABL.Fields.Append TABL.CreateField(ListView1.ColumnHeaders.Item(i).Text, dbText, 250)
Next i
DB.TableDefs.Append TABL
Set RS = DB.OpenRecordset("Excel")
If ListView1.ListItems.Count > 0 Then
If ListView1.ColumnHeaders.Count >= (ListView1.ListItems.Item(1).ListSubItems.Count + 1) Then
InsertAmount = ListView1.ListItems.Item(1).ListSubItems.Count + 1
Else
InsertAmount = ListView1.ColumnHeaders.Count
End If
For i = 1 To ListView1.ListItems.Count
RS.AddNew
If ListView1.ListItems.Item(i).Text <> "" Then
RS.Fields(0) = ListView1.ListItems.Item(i).Text
Else: RS.Fields(0) = "//"
End If
For j = 1 To InsertAmount - 1
If ListView1.ListItems.Item(i).ListSubItems.Item(j).Text <> "" Then
RS.Fields(j) = ListView1.ListItems.Item(i).ListSubItems.Item(j).Text
Else
RS.Fields(j) = "//"
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\listviewToExcel.mdb"
MsgBox "导出数据到Excel表成功!", vbInformation, "提示"
Exit Function
err_handle:
Select Case Err
Case 53:
Resume Next
End Select

End Function

EricaNet 2004-08-25

打赏
举报

其实思路都差不多，灵活掌握。
上面两段都是导出为文本，你要是导出为数字格式，可以在excel中汇总，可以参考这句。
TABL.Fields.Append TABL.CreateField(Flex1.TextMatrix(0, 10), dbDouble, 250) '职贴

EricaNet 2004-08-25

打赏
举报

'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

EricaNet 2004-08-25

打赏
举报

写在模块中，其他窗体就可以调用！

Public Function ListviewExport(ByVal ListView1 As ListView, 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
'If ListView1.ColumnHeaders.Count <= 0 Then
' Exit Sub
'End If

Set WS = DBEngine.CreateWorkspace("WS", "Admin", "", dbUseJet)
Kill App.Path & "\report\listviewToExcel.mdb"
Set DB = WS.CreateDatabase(App.Path & "\report\listviewToExcel.mdb", dbLangGeneral, dbEncrypt)
Set TABL = DB.CreateTableDef("Excel")
For i = 1 To ListView1.ColumnHeaders.Count
TABL.Fields.Append TABL.CreateField(ListView1.ColumnHeaders.Item(i).Text, dbText, 250)
Next i
DB.TableDefs.Append TABL
Set RS = DB.OpenRecordset("Excel")
If ListView1.ListItems.Count > 0 Then
If ListView1.ColumnHeaders.Count >= (ListView1.ListItems.Item(1).ListSubItems.Count + 1) Then
InsertAmount = ListView1.ListItems.Item(1).ListSubItems.Count + 1
Else
InsertAmount = ListView1.ColumnHeaders.Count
End If
For i = 1 To ListView1.ListItems.Count
RS.AddNew
If ListView1.ListItems.Item(i).Text <> "" Then
RS.Fields(0) = ListView1.ListItems.Item(i).Text
Else: RS.Fields(0) = "//"
End If
For j = 1 To InsertAmount - 1
If ListView1.ListItems.Item(i).ListSubItems.Item(j).Text <> "" Then
RS.Fields(j) = ListView1.ListItems.Item(i).ListSubItems.Item(j).Text
Else
RS.Fields(j) = "//"
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\listviewToExcel.mdb"
MsgBox "导出数据到Excel表成功!", vbInformation, "提示"
Exit Function
err_handle:
Select Case Err
Case 53:
Resume Next
End Select

End Function

yijiansong 2004-08-25

打赏
举报

循环取植－导出，ＯＫ

羽毛之家 2004-08-25

打赏
举报

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

hn123 2004-08-25

打赏
举报

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

怎样把listview或msflexgrid中的数据导出到excel中？

相关推荐