VB与数据库应用一例----生成EXCEL表 (转)

VB与数据库应用一例----生成EXCEL表 (转)[@more@]

小生初学炸练,总结了以下一个方法,因为时间有限,所以没有太多检查程序,难免有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 + " orthwind.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






来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10790690/viewspace-951372/,如需转载,请注明出处,否则将追究法律责任。

转载于:http://blog.itpub.net/10790690/viewspace-951372/

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值