Private Sub 历史报表Btn_Click()
成都创新互联是一家专注于成都网站建设、做网站与策划设计,长泰网站建设哪家好?成都创新互联做网站,专注于网站建设十载,网设计领域的专业建站公司;建站业务涵盖:长泰等地区。长泰做网站价格咨询:18980820575
'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册
' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)
' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)
' 4。划===处可根据具体报表修改
Dim strQuery As String
Dim c, i As Integer
Dim r As Integer
Dim Rpt_xls As Excel.Application
Dim dnm(4) As String
Dim MyDate, MyMonth, MyDay, MyHour, MyMinute, MySecond
Dim stDate, stMonth, stDay, stHour, stinute, stSecond, sttime As String
Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String
'++===================================================================
'报表中的 TAG
Dim Items As Integer
dnm(1) = "AI1"
dnm(2) = "AI2"
dnm(3) = "AI3"
dnm(4) = "AI4"
'从历史库中取得域项， 2 - DATATIME, VALUE, TAG 共三项
'--====================================================================
stDate = Date$
sttime = Time$
StartTime = stDate " 00:00:00"
EndTime = stDate + " " + sttime
Set Rpt_xls = New Excel.Application
Rpt_xls.Visible = True
'++============================================================================
'打开的报表文件名
Dim OutReportFile As String
Dim Rpt_f2 As String
Rpt_f2 = "d:\Dynamics\App\HIST"
Rpt_xls.Workbooks.Open Rpt_f2 ".XLS"
Rpt_xls.Sheets("Sheet1").Select
Range("e1").Select
Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
Cells(1, 4).Value = stDate "-" sttime
' Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f2 stDate)
'++==========================================================================
Dim cnADO As New ADODB.Connection
Dim rsADO As Recordset
Set cnADO = New ADODB.Connection
cnADO.ConnectionString = "DSN = FIX Dynamics Historical Data; UID =; PWD = ;"
cnADO.Open "FIX Dynamics Historical Data", "", ""
'============================================================================
'查询，根据报表修改。注意，在“Select VALUE FROM mynd“中，mynd是当前SCADA节点名。
For i = 1 To 4
r = 3
strQuery = "Select VALUE FROM mynd " _
"WHERE (TAG='" dnm(i) "'and " _
"INTERVAL = '00:30:00' and " _
"DATETIME = {ts '" StartTime "'} and " _
"DATETIME = {ts '" EndTime "'})"
'--===========================================================================
MsgBox (strQuery)
Set rsADO = New ADODB.Recordset
rsADO.Open strQuery, cnADO, adOpenForwardOnly, adLockBatchOptimistic
rsADO.MoveFirst
Rpt_xls.Columns("a").Select
Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
While rsADO.EOF True
' MsgBox ("有记录")
Cells(r, i + 1).Value = rsADO.Fields(0)
Cells(r, i + 1).NumberFormatLocal = "0.00"
r = r + 1
rsADO.MoveNext
Wend
MsgBox (r)
Next i
Set cnADO = Nothing
' Rpt_xls.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
' Rpt_xls.ActiveSheet.PageSetup.PaperSize = xlPaperA4
' Rpt_xls.ActiveSheet.PrintOut
' Rpt_xls.DisplayAlerts = False
Rpt_xls.ActiveWorkbook.Save
' OutReportFile = Rpt_f2 "_00" MyMonth MyDay
' Rpt_xls.ActiveWorkbook.SaveAs OutReportFile
Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f2 stDate)
Rpt_xls.Quit
Rpt_xls.DisplayAlerts = True
Set Rpt_xls = Nothing
End Sub
Private Sub 历史数据库Btn_Click()
'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册
' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)
' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)
' 4。划===处可根据具体报表修改
Dim strQuery As String
Dim c As Integer
Dim r As Integer
Dim Intyexcel As Excel.Application
Dim MyDate, MyMonth, MyDay, MyTime, MyHour, MyMinute, MySecond
Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String
'从历史库中取得域项， 2 - DATATIME, VALUE, TAG 共三项
Items = 2
'--====================================================================
MyDate = Format(Now(), "yyyy-mm-dd")
MyTime = Format(Now(), "h:m:s")
StartTime = MyDate " " "00:00:00"
EndTime = Now()
'++==========================================================================
' strQuery = "Select value from Fix " + _
' " Where DATETIME ={ts '" + StrStarTime + "'} AND " + _
' "DATETIME ={ts '" + StrEndTime + "'} AND " + _
' "Tag = " " '" HisDate5(i, 0) "'"
'查询，根据报表修改
strQuery = "Select * From MYND " + _
"WHERE (DATETIME = {ts '" StartTime "'} and " + _
"DATETIME = {ts '" EndTime "'}) and " + _
"(tag = 'AI1')" + _
"and INTERVAL = '00:30:00' "
'--===========================================================================
Dim cnADO As New ADODB.Connection
Dim rsADO As Recordset
Set cnADO = New ADODB.Connection
cnADO.ConnectionString = "DSN = FIX Dynamics Historical Data; UID = ; PWD = ;"
cnADO.Open "FIX Dynamics Historical Data", "", ""
Set rsADO = New ADODB.Recordset
' Rs.Open strQuery, Cn, adOpenStatic, 3, adCmdText
rsADO.Open strQuery, cnADO, adOpenForwardOnly, adLockBatchOptimistic
' rsADO.MoveFirst
'++============================================================================
'打开的报表文件名
Dim Rpt_xls As Excel.Application
Dim OutReportFile As String
Dim Rpt_f1 As String
Set Rpt_xls = New Excel.Application
Rpt_xls.Visible = True
Rpt_f1 = "d:\Dynamics\App\rt1"
Rpt_xls.Workbooks.Open Rpt_f1 ".XLS"
' Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f1 stDate)
'===============================================================================
Rpt_xls.Sheets("Sheet2").Select
Rpt_xls.Range("E1").Select
r = 3
Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
Cells(1, 5).Value = EndTime
While rsADO.EOF True
If rsADO(c) "" Then
Cells(r, 1) = rsADO.Fields(0)
Cells(r, 2) = rsADO.Fields(1)
Cells(r, 3) = rsADO.Fields(2)
Cells(r, 4) = rsADO.Fields(3)
Cells(r, 5) = rsADO.Fields(4)
Cells(r, 6) = rsADO.Fields(5)
Cells(r, 7) = rsADO.Fields(6)
Cells(r, 8) = rsADO.Fields(7)
Cells(r, 9) = rsADO.Fields(8)
End If
r = r + 1
rsADO.MoveNext
Wend
' Intyexcel.Sheets("Sheet1").Select
' Intyexcel.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
' Intyexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
' Intyexcel.ActiveSheet.PrintOut
' Intyexcel.DisplayAlerts = False
' Intyexcel.ActiveWorkbook.Save
' OutReportFile = InReportFile "_00" MyMonth MyDay
' Intyexcel.ActiveWorkbook.SaveAs OutReportFile
' Intyexcel.Quit
' Intyexcel.DisplayAlerts = True
' Set Intyexcel = Nothing
Set cnADO = Nothing
End Sub
Private Sub 实时报表Btn_Click()
'注释: 1。该程序需要安装ADO 2.0目标库并在本机注册
' 2。Microsoft ActiveX Data Objects 2.1 Library 必须被引用 (Office 2000)
' 3。Microsoft Excel 9.0 object libraries 必须被引用 (Office 2000)
' 4。划===处可根据具体报表修改
Dim c As Integer
Dim r As Integer
Dim Rpt_xls As Excel.Application
Dim MyDate, MyMonth, MyDay, MyHour, MyMinute, MySecond
Dim stDate, stMonth, stDay, stHour, stinute, stSecond, sttime As String
Dim StartTime, EndTime, Duration, DisplayDay, DisplayMonth As String
'--====================================================================
stDate = Date$
sttime = Time$
StartTime = stDate " 09:40:00"
EndTime = stDate + " " + sttime
r = 1
Items = 8
Set Rpt_xls = New Excel.Application
Rpt_xls.Visible = True
'++============================================================================
'打开的报表文件名
Dim OutReportFile As String
Dim Rpt_f1 As String
Rpt_f1 = "d:\Dynamics\App\rt1"
Rpt_xls.Workbooks.Open Rpt_f1 ".XLS"
Rpt_xls.ActiveWorkbook.SaveAs (Rpt_f1 stDate)
'===============================================================================
Rpt_xls.Sheets("Sheet1").Select
Rpt_xls.Range("E1").Select
Selection.NumberFormatLocal = "yyyy-mm-dd hh:mm:ss"
Cells(1, 5).Value = stDate sttime
'================================================================================
Cells(3, 2).Value = Fix32.mynd.ai1.f_cv
Cells(3, 3).Value = Fix32.mynd.ai2.f_cv
Cells(3, 4).Value = Fix32.mynd.ai3.f_cv
Cells(3, 5).Value = Fix32.mynd.ai4.f_cv
Range("B3:E3").Select
Selection.NumberFormatLocal = "0.00_ "
'================================================================================
Rpt_xls.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
Rpt_xls.ActiveSheet.PageSetup.PaperSize = xlPaperA4
'Rpt_xls.ActiveSheet.PrintOut
Rpt_xls.DisplayAlerts = False
Rpt_xls.ActiveWorkbook.Save
OutReportFile = Rpt_f1 "_00" MyMonth MyDay
Rpt_xls.ActiveWorkbook.SaveAs OutReportFile
Rpt_xls.Quit
Rpt_xls.DisplayAlerts = True
Set Rpt_xls = Nothing
End Sub
分类: 电脑/网络 软件
解析:
阐述了当前自动化软件的技术特点和发展趋势，并介绍了在iFIX自动化软件中使用VBA访问历史和实时数据的机制。通过一段使用VBA语言编写的程序，实现向Excel输出历史数据，生成历史报表的实例，说明了VBA语言在自动化软件中的应用。
1、自动化软件的发展趋势
自动化软件主要是指那些为用户提供人机操作界面(HMI)的开发和运行环境的软件，有些软件还能够提供回路控制功能，用户可以实现基于PC的控制方案。自动化软件应当具备如下的主要功能及特征：工业过程的动态可视化；数据采集和管理；过程监控和报警；报表和操作记录功能；系统安全等级化管理；为其他企业级程序提供实时和历史数据；简单的回路调节；批量控制等。
近年来，随着计算机和网络技术的发展与应用，自动化软件的发展也呈现如下的发展趋势。
1.1 开放和标准化
近年来，许多自动化软件厂商把通用的标准化编程语言，如微软的VBA(Visual Basic for Applications)集成在自己软件的开发环境中。VBA与VB(Visual Basic)极为相似，只是不能编译成可执行文件，这就为众多熟悉VB的用户提供了一个编程环境。用户在VBA环境中编写程序，可以使用DDE，ActiveX控件，ODBC，COM／DCOM 等技术使得自动化软件演变成开放的软件平台，在软件功能不能满足用户特殊需要时，用户可以根据自己的需要进行二次开发。
同时，OPC(OLE for Process Contro1)技术也是自动化软件的一个热点。OPC是Microsoft公司的对象链接和嵌入OLE／COM技术在过程控制方面的应用，为工业控制领域提供了标准的数据访问机制。
1.2 网络化
随着Inter／Intra的普及，自动化软件又集成了基于TCP／IP协议的网络功能，使其成为协作生产制造过程中的核心系统，实现了企业网络环境下实时数据的管理、实时流程查看、实时趋势浏览、报警记录与查看、报表数据存储、历史趋势存储与查看、生产过程报表生成、生产统计报表生成等功能，从而实现过程控制系统与信息系统的网络集成。用户可以通过IE浏览器登录自动化软件的Web Server服务器，实现远程浏览生产过程。
1.3 管理控制一体化
生产管理信息系统是大型企业重点建设的项目，随着大型数据库技术的日益成熟，自动化软件成为全厂范围内信息收集和集成的工具。在未来企业的信息化进程中，自动化软件将成为硬件设备与生产管理信息系统的桥梁。因为自动化软件能为生产管理信息系统提供生产过程的实时和历史数据，而生产管理信息系统叉对生产过程有着指导作用。
2、VBA在自动化软件中的应用
下面，以iFIX软件为例，通过VBA编写的脚本程序，实现向Excel输出历史数据的实例来具体说明VBA在自动化软件中的应用。
2.1 iFIX软件简介
iFIX软件是GE自动化软件产品家族中的一个基于Windows的HMI／SCADA组件。iFIX是基于开放的和组件技术的产品，专为在工厂级和商业系统之间提供易于集成和协同工作的设计环境。iFIX中还加入了OPC，VBA，ActiveX，DDE，ODBC等工业标准化技术，可以提供一个强大的开发环境，实现用户的特殊需求。
2.2 iFIX软件中VBA的应用实例
a) iFIX的数据访问机制。iFIX中的数据分为实时数据库和历史数据库，这2种数据库的访问方法不同，对于实时数据库，iFIX的VBA项目中提供了各种iFIX对象，利用这些对象，就可以方便地在VBA中实现对iFIX的控制功能；对于历史数据库，可以访问关系数据库来获得历史数据。对于这些关系数据库，各种编程语言大多都提供了相应的数据控件来访问，在VBA 中，通常采用ADO对象模型来访问这些历史数据库。
b) ADO Data控件使用Microsoft ActiveX数据对象(ADO)来快速建立数据绑定的控件和数据提供者之间的连接。数据绑定控件是任何具有“数据源”属性的控件。数据提供者可以是任何符合ODBC规范的数据源。
c) 利用VBA实现Excel报表。通过编写VBA脚本程序，可以实现向Excel输出历史数据，生成Excel报表。其触发方式有2种：一种是通过iFIX的调度程序，以固定的时间或事件来启动VBA脚本程序，生成报表；还可以直接使用VBA生成用户操作界面，用户可以输入开始时间，间隔等参数，由用户点击按钮启动VBA脚本程序，生成报表。这2种方式在程序上大同小异，其主要部分VBA脚本程序如下。其中程序将历史数据、时间、TAG名称等参数送到Excel的Sheet2中，用户可以将Sheet1作为报表版面，通过编辑版面格式，引用Sheet2数据等方式，形成最终报表。
根据用户要求定义所要查询的时间段和变量名称
Dim MyDate，StartTime，EndTime As String Dim Tagl，Tag2 As String
Tagl＝“TIC101．F_CV”
Tag2＝“TIC102．F_CV”
MyDate＝Format(Now()，“yyyy-mm—dd”)
StartTime＝MyDate“ ” “0:00:00”
EndTime＝MyDate“ ” “23:OO:OO”
使用ADO对象来访问ODBC数据库，用SQL语盲查询历史数据
strQuerySamp＝“Select Datetime，Value，Tag From Fix Where Mode＝‘Sample’and (TAG＝‘ “＆ Tagl ”‘or TAG=’” Tag2 ) and Interval＝‘ 01:00:00’and (Datetime) ＞＝{ts‘“ StartTime ”’ )and Datetime＜＝{ts‘“ EndTime ”’})”
Dim ADO As New ADODB．Connection
Dim rsADO As Recordset
Set ADO=New ADODB．Connection
ADO．ConnectionString＝“ DSN= FIX Dynamics Historical Data；UID＝sa；PWD= ；”
AD0．Open “FIX Dynamics Historical Data”，“sa”，“”
Set rsADO— New ADODB．Recordset
rsADO．Open strQuerySamp，ADO，adOpenForwardOnly，adLockBatchOptimistic
调用Excel，将历史数据写入打开的Excel报表文件
Dim 0utReport File，InReportFile As String
Set Intyexcel= New Excel.Application
InReportFile-”C：＼data＼HisReport“
Intyexce1．Workbooks．Open InReportFile “．XLS”
Intyexce1．Sheets(“Sheet2”)．Select
While rsADO．EOF True
With Intyexce1．Worksheets(2)
For C＝0 To Items
If rsADO(c)= “ ”Then ．Cells(r，C + 1)．Value= rsADO(c)
Next C
r； r+ 1
rsADO．M oveNex
End With
W end
关闭Excel，保存报表文件
OutReportFile=InRep0rtFile “_” MyDate
Intyexce1． ActiveW orkbook． SaveAs OutReportFile
Intyexce1．Quit
Set Intyexcel=Nothing
Set ADO==Nothing
3、VBA应用的注意事项与展望
集成了VBA编程语言的自动化软件，变成了标准化的、开放的软件开发平台，这使得自动化软件本身具有了无限的开放性和可扩展性。但同时也带来一些问题。首先，开发人员要确保VBA脚本程序的可靠和精简。VBA程序要经过严格和全面的测试，并要编写出错处理程序，保证生产过程控制的万无一失。其次，目前VBA程序还不能编写多线程程序，开发人员要选择恰当的触发方式，避免发生冲突。
总之，随着最终用户变得更加成熟以及对自动化软件的更加了解，他们将通过编写程序的方式来针对其过程及系统进行更多的定制，以便能够满足其需求。自动化软件将不断为用户提供这样的安全可靠的技术手段。
参考文献
[1] 刘恩涛，赵耀峰．Visual Basic6．0编程技术与实例分析，北京：中国水利水电出版杜，1999．455～456，472～478，479～482
[2] 刘炳文，张绅．Visual Basic程序设计——数据库篇．北京：人民邮电出版社。1999．196～198，224～232，248～251
详细教程：whzx.tzr/read.php?wid=455
非线性动力学，是物理学的思维进入传统方法所不能解决的问题的一座丰碑。也是非常有前途的工具学科，它为大数据时代提供潜在的分析引擎。为什么说非线性，因为物理之外的系统大多数不能用线性系统表述（详情请见《动力学是如何做预测的》）。动力学的核心使命是预测系统的变化，非线性动力学在这点上也是一样的。一个经典的非线性动力学系统具有标准的表述形式：预测一个系统的未来，你需要知道它在微小时间尺度里的性质并列出动力学方程x是一个向量（vector），它所具有的分量个数即系统的维度。维度是动力学系统的最基本属性 。它决定系统的复杂性，及其可能具有的基本性质。 还有，我们有多大把握预测系统的未来。高维空间绝非之存在于宇宙之边（广义相对论）或者加速器的深处（弦论），而是你我的生活中处处皆是。用图形的思维， 讲述复杂性是如何随着维度升高而产生的，同时，庞加莱，秦皇或者凯恩斯又是如何联系起来的。最简单的系统是一维系统，预测一个一维的非线性系统，往往只需抓住一个关键性信息-定点。一维系统与定点（Fix Point） “简单系统偏好平衡”马尔萨斯人口论合不合理？18世纪末，在工业革命前夜的英国，一个叫做马尔萨斯的伟大思想家提出了这样一个困扰了人类几个实的问题： 人类的人口呈指数增长，而食物的总量至多成代数增长， 所以当人口的增长超过食物，人类将不可避免的陷入饥荒，疾病和战争。而普遍性的贫穷，是人类文明的宿命。这个理论解释了为什么许多古代文明陷入发展停滞的泥沼，从埃及，两河领域到古中国。
在VBA中引用Microsoft Excel 11.0 Object Library和Microsoft ADO 6.0 Library。在画面中添加个按钮。复制以下代码：
‘－－－－－－－－－－开始复制(不包括此行)－－－－－－－－－－－－－－
Option Explicit
Dim rsADO As ADODB.Recordset
Dim cnADO As ADODB.Connection
Private Sub Command1_Click()
Dim StrDir As String
StrDir = "E:\"
Dim i As Long
Dim Sql As String
Sql = "SELECT * FROM THISNODE"
Set cnADO = New ADODB.Connection
Set rsADO = New ADODB.Recordset
cnADO.ConnectionString = "rovider = Microsoft OLE DB Provider for ODBC Drivers;DSN=FIX Dynamics Real Time Data;UID=WD="
cnADO.Open
rsADO.CursorLocation = adUseClient
rsADO.Open Sql, cnADO, adOpenDynamic, adLockUnspecified, -1
If rsADO.RecordCount = 0 Then
MsgBox "无数据！", vbOKOnly + vbInformation, "信息"
Set cnADO = Nothing
Set rsADO = Nothing
Exit Sub
End If
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set xlApp = New Excel.Application
xlApp.DisplayAlerts = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(StrDir "\报表.xls")'需要文件(E:\报表.xls)
Set xlSheet = xlBook.Worksheets(1)
For i = 1 To rsADO.RecordCount
xlSheet.Cells(i, 1) = rsADO.Fields(1).Value ""
xlSheet.Cells(i, 2) = rsADO.Fields(2).Value ""
xlSheet.Cells(i, 3) = rsADO.Fields(3).Value ""
xlSheet.Cells(i, 4) = rsADO.Fields(4).Value ""
Next i
xlApp.Visible = True
xlApp.DisplayAlerts = False
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set cnADO = Nothing
Set rsADO = Nothing
End Sub
‘－－－－－－－－－－结束复制(不包括次行)－－－－－－－－－－－－－－
注意：1.iFix历史数据库只支持读90天的数据，在SQL语句中限定时间即可。
2.也可以读取其他数据源的数据，如ACCESS、SQL SERVER等，只要改一下ConnectionString。