Private Sub Command1_Click()
'建立一个ado对象连接
Dim dataconn As ADODB.Connection
Dim datarec As ADODB.Recordset
Dim strsql As String
'若数据库连接出错,转向connectionErr
' On Error GoTo connectionErr
Set dataconn = New ADODB.Connection
dataconn.Open "driver={sql server};server=localhost;uid=sa;pwd=4414;database=pubs"
'建立数据库的连接
'若recordset 建立出错,则转向recordsetErr
' On Error GoTo recordsetErr
Set datarec = New ADODB.Recordset
strsql = "select au_lname,au_fname,phone,address,city from authors"
datarec.Open strsql, dataconn, adOpenKeyset, adLockOptimistic
If datarec.EOF Then
Exit Sub
End If
Dim excelappx As Excel.Application
Dim rowcount As Long
Dim columncount As Long
Dim tmpvalue As Variant
rowcount = 3
' On Error GoTo excelErr
'建立excel应用
Set excelappx = CreateObject("excel.application")
With excelappx
.Visible = True
'新增workbook
.Workbooks.Add (App.Path & "\authors.xlt")
'添加数据
Do Until datarec.EOF
'填充每一列
For columncount = 1 To datarec.Fields.Count
'定位到单元格
'//////就是下面的这句话出错!
excelappx.Range(excelappx.Cells(columncount, rowcount)).Select
'填充数据
excelappx.ActiveCell.Value = datarec.Fields(columncount - 1).Value
Next columncount
datarec.MoveNext
rowcount = rowcount + 1
Loop
excelappx.Range(excelappx.Cells(3, 1), excelappx.Cells(rowcount - 1, columncount - 1)).Borders.LineStyle = xlContinuous
'打印玉兰
'excelappx.Worksheets .PrintPreview
excelappx.DisplayAlerts = False
excelappx.Quit
End With
Exit Sub
connectionErr:
MsgBox "数据库连接错误!"
Exit SubrecordsetErr:
MsgBox "记录集错误!"
dataconn.Close
Exit Sub
excelErr:
MsgBox "excel报表有错误!", Err.Description, vbCritical, "出错"
If Not excelappx Is Nothing Then excelappx.Quit
datarec.Close
dataconn.Close
Exit Sub
End Sub
'建立一个ado对象连接
Dim dataconn As ADODB.Connection
Dim datarec As ADODB.Recordset
Dim strsql As String
'若数据库连接出错,转向connectionErr
' On Error GoTo connectionErr
Set dataconn = New ADODB.Connection
dataconn.Open "driver={sql server};server=localhost;uid=sa;pwd=4414;database=pubs"
'建立数据库的连接
'若recordset 建立出错,则转向recordsetErr
' On Error GoTo recordsetErr
Set datarec = New ADODB.Recordset
strsql = "select au_lname,au_fname,phone,address,city from authors"
datarec.Open strsql, dataconn, adOpenKeyset, adLockOptimistic
If datarec.EOF Then
Exit Sub
End If
Dim excelappx As Excel.Application
Dim rowcount As Long
Dim columncount As Long
Dim tmpvalue As Variant
rowcount = 3
' On Error GoTo excelErr
'建立excel应用
Set excelappx = CreateObject("excel.application")
With excelappx
.Visible = True
'新增workbook
.Workbooks.Add (App.Path & "\authors.xlt")
'添加数据
Do Until datarec.EOF
'填充每一列
For columncount = 1 To datarec.Fields.Count
'定位到单元格
'//////就是下面的这句话出错!
excelappx.Range(excelappx.Cells(columncount, rowcount)).Select
'填充数据
excelappx.ActiveCell.Value = datarec.Fields(columncount - 1).Value
Next columncount
datarec.MoveNext
rowcount = rowcount + 1
Loop
excelappx.Range(excelappx.Cells(3, 1), excelappx.Cells(rowcount - 1, columncount - 1)).Borders.LineStyle = xlContinuous
'打印玉兰
'excelappx.Worksheets .PrintPreview
excelappx.DisplayAlerts = False
excelappx.Quit
End With
Exit Sub
connectionErr:
MsgBox "数据库连接错误!"
Exit SubrecordsetErr:
MsgBox "记录集错误!"
dataconn.Close
Exit Sub
excelErr:
MsgBox "excel报表有错误!", Err.Description, vbCritical, "出错"
If Not excelappx Is Nothing Then excelappx.Quit
datarec.Close
dataconn.Close
Exit Sub
End Sub
解决方案 »
- 有没有API或VB的方法可以做到给指定位置截图的功能?
- vsflexgrid绑定recordset出错,求助,谢谢
- 如何捕捉其它应用程序窗口中某一控件的事件?
- 如何设置ACCESS为相对路径?
- 我写了一个,透明窗体的子程序,但不知如何取消半透明窗体
- 请教:索引有什么用?具体用法实例。
- 关于一个用soap访问webservice的问题~~~~~~~~~
- 菜鸟问题2
- vb为开发工具,SQL server做数据库,如何在VB中实现多条件的查询?
- execute可以直接获取字段值么
- 怎么会有这个错误,我在线等?谢谢先!
- 各位高手,有谁知道怎么把本地数据库里的数据反映到另一个机子的窗体上去.(注意,窗体不能联在本地数据库.)
ExcelApp.Range(ExcelApp.Cells(1, 1), ExcelApp.Cells(1, 1)).Select
excelappx.Range(excelappx.Cells(columncount, rowcount),excelappx.Cells(columncount, rowcount)).Select