办公用品管理系统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()            '创建工作表

    XlsSheet.SaveAs "D:\当前库存.xls" '保存

    XlsSheet.Cells(, ) = "序号"
    XlsSheet.Cells(, ) = "办公用品名称"
    XlsSheet.Cells(, ) = "一级分类名称"
    XlsSheet.Cells(, ) = "二级分类名称"
    XlsSheet.Cells(, ) = "型号"
    XlsSheet.Cells(, ) = "库存数量"
    XlsSheet.Cells(, ) = "库存下限"
    XlsSheet.Cells(, ) = "备注"

    For i =  To DataGrid1.Columns.Count -
    For j =  To DataGrid1.ApproxCount -
    DataGrid1.Col = i
    On Error Resume Next
    DataGrid1.Row = j
    XlsSheet.Cells(j + , i + ) = 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()

  xlSheet.Columns.AutoFit
  Me.MousePointer =
   For k =  To DataGrid1.Columns.Count -  'DataGrid所有的列数
     xlSheet.Cells(, k + ) = DataGrid1.Columns(k).Caption '第一行为DataGrid的列标题
   Next
   DataGrid1.Scroll , -DataGrid1.FirstRow '导出前拉动过垂直滚动条，这个非常重要
   DataGrid1.Row =
   For i =  To DataGrid1.ApproxCount -  'DataGrid的所有行数

      For j =  To DataGrid1.Columns.Count -  'DataGrid所有的列数,若将此数改小到不拉DataGrid的垂直滚动条的时候能看见的行数的时候正常
         DataGrid1.Col = j
         xlSheet.Cells(i + , j + ) = Adodc1.Recordset(j) 'DataGrid1.Text '从第二行显示'DataGrid的内容，这里修改成这样也可以DataGrid1.Columns.Item(j).Text
      Next
     If i < DataGrid1.ApproxCount -  Then
       DataGrid1.Row = DataGrid1.Row +
     End If
   Next
  Me.MousePointer =
  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(, ) = "序号"
    xlsApp.Cells(, ) = "办公用品名称"
    xlsApp.Cells(, ) = "一级分类名称"
    xlsApp.Cells(, ) = "二级分类名称"
    xlsApp.Cells(, ) = "型号"
    xlsApp.Cells(, ) = "库存数量"
    xlsApp.Cells(, ) = "库存下限"
    xlsApp.Cells(, ) = "备注"
    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