办公用品管理系统VB——库存数量导出EXCEL,SaveEXCEL

办公用品管理系统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

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

编辑于

我来说两句

0 条评论
登录 后参与评论

相关文章

来自专栏程序员叨叨叨

当你刷新RecyclerView程序崩掉的时候

今天测试 APP的时候发现一个有关RecyclerView的BUG,我们先上图来看看崩溃情况:

15720
来自专栏圣杰的专栏

Asp.net mvc 知多少(三)

本系列主要翻译自《ASP.NET MVC Interview Questions and Answers 》- By Shailendra Chauhan,想...

22060
来自专栏GIS讲堂

Arcgis for Android解决中文字体乱码的问题

首先,在此感谢Arcgis for Android群里的一位成员,大家可以加进来QQ群号:337469080。

20640
来自专栏高性能服务器开发

从零学习开源项目系列(四)LogServer源码探究

这是从零学习开源项目的第四篇,上一篇是《从零学习开源项目系列(三) CSBattleMgr服务源码研究》,这篇文章我们一起来学习LogServer,中文意思可能...

27020
来自专栏Android 研究

APK安装流程详解1——有关"安装ing"的实体类概述

该类包含了从AndroidManifest.xml文件中收集的所有信息。 PackageInfo.java源码地址 通过源码我们知道PackageInfo是...

20420
来自专栏刘望舒

Android PMS处理APK的复制

在上一篇文章Android包管理机制之PackageInstaller安装APK中,我们学习了PackageInstaller是如何安装APK的,最后会将APK...

22750
来自专栏c#开发者

Angularjs 通过asp.net web api认证登录

Angularjs 通过asp.net web api认证登录 Angularjs利用asp.net mvc提供的asp.net identity,member...

35970
来自专栏GIS讲堂

web中的树形结构【小结】

最近在做一个项目,是一个b/s架构的,在项目中,用到了树形结构,即如图1所示的结构。

32820
来自专栏晓晨的专栏

.NET Core 实现定时抓取博客园首页文章信息并发送到邮箱

9630
来自专栏IMWeb前端团队

React函数式进阶

React让很多人让追捧的一个特性是它的所有的组件都是完全由JavaScript组成的。组件的定义是JavaScript,组件的模板也可以是JavaScript...

24260

扫码关注云+社区

领取腾讯云代金券