VB做报表,哪个最好?

likesoft 2002-03-24 09:22:37
做数据库管理系统时,要做报表输出,但使用自带的报表系统好象灵活性太差,使用不方便,请教各位,给指条路。
...全文
104 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
liuliguo940 2002-03-25
  • 打赏
  • 举报
回复
我认为Excel比较好
lihonggen0 2002-03-25
  • 打赏
  • 举报
回复
实际上根据你的要求
用DataReport
ActivateReport
水晶报表都行
lihonggen0 2002-03-25
  • 打赏
  • 举报
回复
'用Excel作报表

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
' SSPanel2.Visible = True
' probar.Value = 0
' 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_temp.Fields.Count - 1) '从rs中头一个字段到最后一个
' col = Chr(I) & "2" 'chr(66)就是b
' Range(col).Select
' ActiveCell.FormulaR1C1 = Rs_temp.Fields(J).Name '
' J = J + 1
' Next I
' '*************以先横后竖顺序画表***************
' K = 0
' Rs_temp.MoveFirst
' DoEvents
' For J = 3 To 3 + Rs_temp.RecordCount '本程序从b3开始,所以用3
' K = 0
' For I = 66 To (66 + Rs_temp.Fields.Count - 1)
' col = Chr(I) & CStr(J) '得到目标表格的值如 c3
' Range(col).Select
' ActiveCell.FormulaR1C1 = Rs_temp.Fields(K)
' K = K + 1
' Next I
' On Error Resume Next
' probar.Value = probar.Value + 1
' Rs_temp.MoveNext
' If Rs_temp.EOF = True Then
' SSPanel2.Visible = False
' .Application.Visible = True
' End If
' Next J
' End With
'excle:
' MsgBox ("您没有安装excle2000,请先安装excel2000")

Dim Irow, Icol As Integer
Dim Irowcount, Icolcount As Integer
Dim Fieldlen1 As Integer
'存字段长度值
Dim Fieldlen()
'Dim xlApp As Excel.Application
'Dim xlBook As Excel.Workbook
'Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

SSPanel2.Visible = True
probar.Value = 0

'On Error GoTo excle
With Rs_temp
.MoveLast

If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Sub
End If

'记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .Fields.Count

ReDim Fieldlen(Icolcount)
.MoveFirst

For Irow = 1 To Irowcount + 1

For Icol = 1 To Icolcount
Select Case Irow
'在Excel中的第一行加标题
Case 1
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
'将数组FIELDLEN()存为第一条记录的字段长
Case 2
If IsNull(.Fields(Icol - 1)) = True Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
'如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
Else
Fieldlen(Icol) = LenB(.Fields(Icol - 1))
End If

xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
'Excel列宽等于字段长
xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
'向Excel的CellS中写入字段值
Case Else
If IsNull(.Fields(Icol - 1)) Then
Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
Else
Fieldlen1 = LenB(.Fields(Icol - 1))
End If

If Fieldlen(Icol) < Fieldlen1 Then
xlSheet.Columns(Icol).ColumnWidth = IIf(Fieldlen1 > 255, 255, Fieldlen1)
'表格列宽等于较长字段长
Fieldlen(Icol) = IIf(Fieldlen1 > 255, 255, Fieldlen1)
'数组Fieldlen(Icol)中存放最大字段长度值
Else
xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
End If

xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
End Select
Next

If Irow > 2 Then
If Not .EOF Then .MoveNext
End If

If Not .EOF Then
If Irow < Irowcount Then
probar.Value = probar.Value + 1
End If
End If

Next

'网格线
With xlSheet
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
'设标题为黑体字
.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
'标题字体加粗
.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
'设表格边框样式
End With

'*!* 页眉、填报单位、报表时间、单位
With xlSheet.PageSetup
.LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称:" ' & Gsmc
.CenterHeader = "&""楷体_GB2312,常规""业务数据综合查询表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期:"
.RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位:"
.LeftFooter = "&""楷体_GB2312,常规""&10制表人:"
.CenterFooter = "&""楷体_GB2312,常规""&10制表日期:"
.RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
End With

'显示表格
Dim ExclFileName As String
ExclFileName = App.path & "\业务数据综合查询表.xls"
If Dir(ExclFileName) <> "" Then
Kill ExclFileName
End If
xlSheet.SaveAs (ExclFileName)
SSPanel2.Visible = False
xlApp.Application.Visible = True
'交还控制给Excel
'xlSheet.PrintPreview
'xlApp.Quit
End With
'excle:
' MsgBox ("您没有安装 Excle2000,请先安装 Excel2000 !")
Case 2
Unload Me
End Select
End Sub
MilkyWaySoft 2002-03-25
  • 打赏
  • 举报
回复
关注!
ferrytang 2002-03-25
  • 打赏
  • 举报
回复
导出到execl
www.21code.com

809

社区成员

发帖
与我相关
我的任务
社区描述
VB 多媒体
社区管理员
  • 多媒体
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧