内容发布更新时间 : 2024/4/27 3:24:33星期一 下面是文章的全部内容请认真阅读。

Private Sub Combobox5_change() If ComboBox6.Text <> \ComboBox6.Text = \End If

If ComboBox5.Text = \库位状态日报表\X = 1

Call CommandButton1_Click

ElseIf ComboBox5.Text = \货物情况日报表\X = 2

Call Choice

Call CommandButton1_Click …………….. End sub

2）初始化时间和下拉菜单

使运行状态下结束时间总是为当前系统时间，开始时间总是退后一个小时，方便得到最新的数据。

Private Sub CFixPicture_Initialize() '初始化时间

Me.DTPstart = DateAdd(\Me.DTPend = Now '初始化下拉菜单

IEPOP1.AddItem \打开\IEPOP1.AddItem \关闭\IEPOP1.AddItem \保存\…………… End Sub

3）主程序的设计

Ⅰ向该窗体加入日期时间控件DTPicker和浏览器控件WebBrower。

Ⅱ选择各报表类型，软件将按照指定的已选择的查询变量进行数据查询。 Private Sub CommandButton1_Click()

On Error GoTo exect ‘发生错误跳转，执行相应的动作。

Ⅲ 对时间日期控件转换成格式化字符串。

'处理开始时间StartDate = Format(Me.DTPstart, \'处理结束时间DtmMonth = DateAdd(\1, Format(Me.DTPstart, \& \

DtmMonth = Format(Me.DTPend, \

'设置时间间隔strInterVal = Format(Me.DTPinterval1.Value, \ '查询语句

If X = 6 Then ‘表示当X=6时从THISNODE读取其中符合时间限制的VALUE,DATETIME,TAG 。

Sql = \ \ \

\End If

Ⅳ '连接并读取数据库[8]

Set cnADO = New ADODB.Connection ‘创建新的Connection对象赋值给该变量Set rsADO = New ADODB.Recordset ‘创建新的记录集.Recordset对象赋值给该变量

If X = 7 Then ‘指定连接字符串，将access数据库建立好后可以放置在当前工程的APP目录下，方便管理，这里使用共享数据库 SqlString1 = \

SqlString2 = \客户信息 \

SqlString3 = \公司ID=\卡片属性='提货' \

SqlString4 = \编号=\

Sql = SqlString1 & SqlString2 & SqlString3 & SqlString4

cnADO.ConnectionString = \Source = \\\\GE25\\SharedDocs\\公司信息.mdb;Persist\Else

cnADO.ConnectionString = \ODBC Drivers;\

\ End If

cnADO.Open ‘ 使用Open 方法打开连接 rsADO.CursorLocation = adUseClient

rsADO.Open Sql, cnADO, adOpenDynamic, adLockUnspecified, -1

Ⅴ ‘判断有无数据，当rsADO.RecordCount即要查询的数据对应的行数<=0时跳出对话框。

If rsADO.RecordCount <= 0 Then MsgBox \该时间范围内无数据\ Exit Sub End If

Ⅵ 'Excel报表制作，创建符合需求的Excel模板。[4] ‘X代表同一张工作簿中不同的工作表，如X=1代表sheet1，X=2代表sheet2。。。 Set ExcelApp = CreateObject(\‘创建新的Excel进程

Set ExcelBook = ExcelApp.Workbooks.Open(System.ProjectPath & \报表.htm\

Set ExcelSheet = ExcelBook.Worksheets(X) ExcelApp.Selection.ClearContents ExcelBook.Worksheets(X).Select rsADO.MoveFirst

Ⅶ '不同报表中选择不同数据处理方式 Select Case X Case 1

Call DO1 。。。。。。。 End Select

’保存关闭Excel进程

ExcelBook.Save ExcelBook.Close

'将处理后的报表在浏览器中显示出来 With Me.WebBrowser1

.Navigate System.ProjectPath & \报表.htm\ .AddressBar = False End With 释放变量

Set ExcelApp = Nothing Set ExcelBook = Nothing Set ExcelSheet = Nothing Set cnADO = Nothing Set rsADO = Nothing Q = 1

ThisWorkbook.Close savechanges:=False

exect: ‘发生错误跳转位置。 If Q <> 1 Then ExcelApp.Quit

MsgBox CStr(Err.Number) + Err.Description End If

Set cnADO = Nothing Set rsADO = Nothing Set ExcelApp = Nothing Set ExcelBook = Nothing Set ExcelSheet = Nothing End Sub

4）子程序

在报表使用过程中，子程序的功能为处理在Excel显示出来的数据和读取各类数据库中的数据，模块化的方式，方便不同的用户根据实际需要进行调整，在保证主程序的同时，只需分块修改子程序，就可达到相应的功能。 Ⅰ '选择库位状态日报表时的数据处理方式 Sub DO1()

Dim rr =0 As Integer Dim n=0 As Integer Dim m=1 As Integer

For i = 5 To rsADO.RecordCount + 54 ‘rsADO.RecordCount 为每次调用的数据的的总个数

If m >= 0 And m <= 6 Then

Do While i = Int((rsADO.RecordCount) * (m) / 18) + 5 ‘将数据平均分成18份，写入18个库位对应的表格中

n = n + 3 ‘一个库位写完，换3行，再次写入

rr = rr + rsADO.RecordCount / 18 m = m + 1

If m = 7 Then Exit Do Loop

If m = 7 Then

i = i + rsADO.RecordCount / 18 + 4 n = n - 18 End If

。。。。。。。。。 End If

With ExcelSheet ‘将数据写入Excel中

Range(Chr(Asc(\ If rsADO!Value & \

Range(Chr(Asc(\无数据\ Else

Range(Chr(Asc(\ End If

Range(Chr(Asc(\ End With

rsADO.MoveNext Next i End Sub

Ⅱ '选择客户报表时的数据处理方式，从ACCESS数据库中读取相应的数据。 Sub DO5() For j = 1 To rsADO.RecordCount

ExcelSheet.Cells((j + 5), 1) = rsADO.Fields(0).Value & \ExcelSheet.Cells((j + 5), 2) = rsADO.Fields(1).Value & \ExcelSheet.Cells((j + 5), 3) = rsADO.Fields(2).Value & \ExcelSheet.Cells((j + 5), 4) = rsADO.Fields(3).Value & \ExcelSheet.Cells((j + 5), 9) = rsADO.Fields(4).Value & \rsADO.MoveNext Next j End Sub

Ⅲ '打印报表子程序

Sub AA() Dim Msg, Style, Title, Help, Ctxt, Response, MyString

Dim bPrinted As Boolean

Msg = \您真的要打印此报表吗 ?\定义消息文本 Style = vbYesNo + vbDefaultButton2 ' 定义按钮 Title = \打印窗口\定义标题文本 Help = \定义帮助文件 Ctxt = 1200 ' 定义帮助主题

Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then ' 用户按下“是”

bPrinted = Application.ActiveDocument.PrintOut ' 完成打印操作 ExcelApp.ActiveSheet.PageSetup.Orientation = xlPortrait ExcelApp.ActiveSheet.PageSetup.PageSize = xlPaperA4 ExcelApp.ActiveSheet.PrintOut Else

End ' 用户按下“否”,返回原报表 End If End Sub

Ⅳ '调用打印机的声明和子函数

Private Declare Function PrintDlg Lib \_

(pPrintdlg As PrintDlg) As Long Private Type PrintDlg lStructSize As Long hwndOwner As Long hDevMode As Long hDevNames As Long hdc As Long flags As Long

nFromPage As Integer nToPage As Integer nMinPage As Integer nMaxPage As Integer nCopies As Integer hInstance As Long lCustData As Long lpfnPrintHook As Long lpfnSetupHook As Long

lpPrintTemplateName As String lpSetupTemplateName As String hPrintTemplate As Long hSetupTemplate As Long End Type

‘其他子程序可以上述方式依次添加，这里不再赘述。 3.5具体调试实现过程：