辦公用品管理系統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