办公用品管理系统VB——库存数量导出EXCEL,SaveEXCEL
总体来说,VB的EXCEL导出效率还是蛮低的,就是一个小型化的办公用品管理软件,不再优化了。
时间紧迫,就没有从头到尾的用C#编写,从网上看见有源码就直接COPY下来的,添加了一点小功能,编译后给了朋友使用。
VB6.0编写的,蛮古老的开发语言,算是学习编程时第一个学会的语言,真是许久没有使用,有些生疏了。
上一下运行效果:
Private Sub SaveEXCEL_Click() Dim Introws As Integer '用作循环,标识MSHFlexGrid总行数 Dim Intcols As Integer '用作循环,标识MSHFlexGrid的总列数 Dim XlsApp As Excel.Application '定义EXCEL对象 Dim XlsSheet As Excel.Worksheet '定义EXCEL表 Dim XlsBook As Excel.Workbook '定义EXCEL的工作薄 Set XlsApp = CreateObject("Excel.Application") '实例化EXCEL对象 Set XlsBook = XlsApp.Workbooks.Add '加载工作薄 Set XlsSheet = XlsBook.Worksheets(1) '创建工作表 XlsSheet.SaveAs "D:\当前库存.xls" '保存 XlsSheet.Cells(1, 1) = "序号" XlsSheet.Cells(1, 2) = "办公用品名称" XlsSheet.Cells(1, 3) = "一级分类名称" XlsSheet.Cells(1, 4) = "二级分类名称" XlsSheet.Cells(1, 5) = "型号" XlsSheet.Cells(1, 6) = "库存数量" XlsSheet.Cells(1, 7) = "库存下限" XlsSheet.Cells(1, 8) = "备注" For i = 0 To DataGrid1.Columns.Count - 1 For j = 0 To DataGrid1.ApproxCount - 1 DataGrid1.Col = i On Error Resume Next DataGrid1.Row = j XlsSheet.Cells(j + 2, i + 1) = DataGrid1.Columns.Item(i).Text Next j Next i '释放对象 XlsApp.Visible = True Set XlsApp = Nothing End Sub
上面的代码输出的时候总是把最后一行重复输出N多次。找到上面代码的原因了,什么也不说了上代码
Dim i As Integer Dim j As Integer Dim k As Integer Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Set xlApp = New Excel.Application Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) xlSheet.Columns.AutoFit Me.MousePointer = 11 For k = 0 To DataGrid1.Columns.Count - 1 'DataGrid所有的列数 xlSheet.Cells(1, k + 1) = DataGrid1.Columns(k).Caption '第一行为DataGrid的列标题 Next DataGrid1.Scroll 0, -DataGrid1.FirstRow '导出前拉动过垂直滚动条,这个非常重要 DataGrid1.Row = 0 For i = 0 To DataGrid1.ApproxCount - 1 'DataGrid的所有行数 For j = 0 To DataGrid1.Columns.Count - 1 'DataGrid所有的列数,若将此数改小到不拉DataGrid的垂直滚动条的时候能看见的行数的时候正常 DataGrid1.Col = j xlSheet.Cells(i + 2, j + 1) = Adodc1.Recordset(j) 'DataGrid1.Text '从第二行显示'DataGrid的内容,这里修改成这样也可以DataGrid1.Columns.Item(j).Text Next If i < DataGrid1.ApproxCount - 1 Then DataGrid1.Row = DataGrid1.Row + 1 End If Next Me.MousePointer = 0 MsgBox "导出成功!" xlApp.Visible = True Set xlApp = Nothing 'Excel 处于当前窗体 Set xlBook = Nothing Set xlSheet = Nothing
最终应用的方法,这样比较迅速导出,直接导出Adodc,还是从数据根源导出好一点。
Private Sub SaveEXCEL_Click() Dim i As Long, j As Long Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Set xlsApp = New Excel.Application Set xlsApp = CreateObject("Excel.Application") xlsApp.Visible = True xlsApp.Workbooks.Add 'Set xlsBook = xlsApp.Workbooks.Open(App.Path & "\filename.xls") xlsApp.Sheets("sheet1").Select xlsApp.Cells(1, 1) = "序号" xlsApp.Cells(1, 2) = "办公用品名称" xlsApp.Cells(1, 3) = "一级分类名称" xlsApp.Cells(1, 4) = "二级分类名称" xlsApp.Cells(1, 5) = "型号" xlsApp.Cells(1, 6) = "库存数量" xlsApp.Cells(1, 7) = "库存下限" xlsApp.Cells(1, 8) = "备注" xlsApp.ActiveSheet.Range("A2").CopyFromRecordset Adodc1.Recordset If xlsApp.ActiveWorkbook.Saved = False Then xlsApp.ActiveWorkbook.SaveAs App.Path & "\当前库存.xls" End If 'xlsApp.Quit Set xlsApp = Nothing End Sub