VB與數據庫應用一例----生成EXCEL表

小生初學炸練，總結了以下一個方法，因為時間有限，所以沒有太多檢查程序，難免有BUG，但是關鍵功能沒有問題。這測試過了，嘿嘿。

這個程序可以將下圖表格中(MSHFLEXGRID控件)的
數據生成一個EXCEL表，這樣可以省去用VB
來編寫打印排版程序的麻煩。想一想自已動
手用VB或DELPHI寫一個像EXCEL的排版功能
一樣的東東，是多么的恐怖!!。所以嘿嘿。。

http://go.163.com/~chunpeng/Project/Grid.jpg

原程序下載：
因為我用的是ACCESS2000的樣本數據庫---
NorthWind.mdb 所以安了OFFICE2000的可以
下載下面這個：(不代NorthWind.mdb，下載后請將
Office2000里那個COPY到這個程序的目錄中就行)
go.163.com/~chunpeng/Project/PrintExcela.zip

沒有NorthWind.mdb的可以下載這個：
go.163.com/~chunpeng/Project/PrintExcel.zip


高手可以直接看下面，如果用VB做過數據庫應
用的朋友給點意見，這種方法我曾在多個MIS
系統中見過，只不過生成的是WORD文檔。這是
一種比較典型的方法。

Public WithEvents rs As ADODB.Recordset
Dim conn As ADODB.Connection
Dim myPanel As Panel



Private Sub Form_Load()
Set rs = New ADODB.Recordset
Set conn = New ADODB.Connection
conn.CursorLocation = adUseClient
conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\northwind.mdb;"
rs.Open "select *from 產品", conn, adOpenStatic, adLockOptimistic
Set MSgrid1.DataSource = rs

StatusBar1.Panels.Clear
Set myPanel = StatusBar1.Panels.Add(, "Record")
myPanel.AutoSize = sbrContents
myPanel.Text = "總共有" & " " & rs.RecordCount & " " & "條記錄"
End Sub


Private Sub Form_Resize()
With MSgrid1
.Left = 0
.Top = Toolbar1.Height
.Width = Me.ScaleWidth - 10
.Height = Me.ScaleHeight - (StatusBar1.Height + 700)
End With


End Sub

Private Sub Print_cmd_Click()
Form2.Show
Dim myExcel As New Excel.Application, i, j, k As Integer, col As String
With myExcel
On Error GoTo Excle
.Application.Visible = False
.Workbooks.Add


'***********畫字段************
j = 0
'Example: B2 ----G2 '列 本程序從B列,和第2行開始
For i = 66 To (66 + rs.Fields.Count - 1) '從RS中頭一個字段到最后一個
col = Chr(i) & "2" 'Chr(66)就是B
'Debug.Print col
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(j).Name '
j = j + 1
Next i
'****************************
'*************以先橫后豎順序畫表***************
k = 0
rs.MoveFirst
DoEvents
For j = 3 To 3 + rs.RecordCount '本程序從B3開始，所以用3
k = 0
For i = 66 To (66 + rs.Fields.Count - 1)
col = Chr(i) & CStr(j) '得到目標表格的值如 C3
Range(col).Select
ActiveCell.FormulaR1C1 = rs.Fields(k)
k = k + 1
Next i
On Error Resume Next
Form2.Probar.Value = Form2.Probar.Value + 1
rs.MoveNext

If rs.EOF = True Then
Unload Form2
.Application.Visible = True
End If

Next j
'************************************
End With
Exit Sub

Excle:
MsgBox ("您沒有安裝EXCLE2000，請先安裝EXCEL2000")
End Sub