精华内容
下载资源
问答
  • 新增一个模块'class name: adosql for vba useOption ExplicitPrivate ObjConnection As New ADODB.ConnectionPrivate ObjCommand As New ADODB.CommandPublic ObjRecordSet As New ADODB.Recor...

    1.首先Excel要引用相应的ActiveX库

    226596f9c6312dfb416060041513c8dc.png

    2.新增一个类模块

    'class name: adosql for vba use

    Option Explicit

    Private ObjConnection As New ADODB.Connection

    Private ObjCommand As New ADODB.Command

    Public ObjRecordSet As New ADODB.Recordset

    Private para(16) As New ADODB.Parameter

    Private Sub class_initialize() '构造函数

    ObjConnection.CommandTimeout = 15

    ObjConnection.ConnectionTimeout = 15

    End Sub

    Public Sub openDsn(strDSN As String) '打开数据库连接

    If Len(strDSN) = 0 Then

    MsgBox "DSN不能为空."

    Exit Sub

    End If

    If Right(strDSN, 1) = ";" Then

    ObjConnection.Open strDSN

    Else

    ObjConnection.Open strDSN & ";"

    End If

    End Sub

    Public Sub setCmd(strQUERY As String, cmdTYPE As Integer) '设置命令

    ObjCommand.ActiveConnection = ObjConnection

    ObjCommand.CommandText = strQUERY

    ObjCommand.CommandType = cmdTYPE '1-语句 4-存储过程

    ObjConnection.CursorLocation = 3 '本地游标库提供的客户端游标

    ObjRecordSet.CursorType = 3 '静态游标

    End Sub

    Public Sub inpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 1, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparastr(s As Integer, paname As String, palen As String, pavalue As String) '参数个数 参数名 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, "202", 1, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparaint(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "3", 1, "8", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparadate(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "7", 1, "10", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparabool(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "11", 1, "1", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparadec(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "14", 1, "18", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub outpara(s As Integer, paname As String, paformat As String, palen As String) '参数个数 参数名 字符类型 长度

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 2, palen)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inoutpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 3, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Function outvalue(s As Integer) As String '返回指定参数返回值

    outvalue = para(s).Value

    End Function

    Public Sub rlspara(s As Integer) '释放参数对象

    Dim i As Integer

    For i = 1 To s

    ObjCommand.Parameters.Delete para(i).Name

    Set para(i) = Nothing

    Next

    End Sub

    Public Function execRT() As Integer '执行CMD 并返回记录数

    Set ObjRecordSet = ObjCommand.Execute

    execRT = CInt(ObjRecordSet.RecordCount)

    End Function

    Public Function getRT() As ADODB.Recordset '返回记录集

    Set getRT = ObjCommand.Execute

    End Function

    Private Sub mfirst() '游标定位到第一条

    ObjRecordSet.MoveFirst

    End Sub

    Private Sub mnext() '游标定位到下一条

    ObjRecordSet.MoveNext

    End Sub

    Public Function getvalue(fieldname As Integer) As String '取值 BY name

    getvalue = ObjRecordSet.Fields(fieldname).Value

    End Function

    Public Function numvalue(fieldnum As Integer) As String '取值 BY number

    numvalue = ObjRecordSet.Fields(fieldnum).Value

    End Function

    Public Sub clsrcd() '关闭结果集

    ObjRecordSet.Close

    End Sub

    Public Sub clscon() '关闭连接

    ObjConnection.Close

    End Sub

    Public Function scalar(strQUERY As String) As String '返回字符串值

    Dim ct As Integer

    Call setCmd(strQUERY, 1)

    ct = execRT()

    If ct > 0 Then

    Call mfirst

    scalar = numvalue(0)

    Else

    scalar = ""

    End If

    Call clsrcd

    End Function

    Public Sub rlscon() '释放所有对象

    Set ObjRecordSet = Nothing

    Set ObjCommand = Nothing

    if ObjConnection.State = adStateOpen Then

    ObjConnection.Close

    endif

    Set ObjConnection = Nothing

    End Sub

    Private Sub Class_Terminate() '析构函数

    Set ObjRecordSet = Nothing

    Set ObjCommand = Nothing

    if ObjConnection.State = adStateOpen Then

    ObjConnection.Close

    endif

    Set ObjConnection = Nothing

    End Sub

    3.新增一个SUB在模块里

    测试连接数据库(PROGRESS)

    Option Explicit

    Public Sub test1()

    Dim ado As adosql

    Set ado = New adosql

    ado.openDsn "Dsn=mfgtest;uid=sql;pwd=123;host=xxx.xx.xx.xx;port=xxxx;db=mfgdb;"

    Dim sqlstr As String

    sqlstr = "select ifnull(sum(op_qty_comp),0) from pub.op_hist where op_domain = 'CN01' and op_site = 'CN01' and op_type = 'BACKFLSH' and op_date = ? and op_part = ? and op_wo_op = ?"

    ado.inparadate 1, "@date", "2020-04-28"

    ado.inparastr 2, "@part", "18", "ABC0001"

    ado.inparaint 3, "@op", "40"

    MsgBox (ado.scalar(sqlstr))

    ado.rlspara 3

    Set ado = Nothing

    End Sub

    测试连接数据库(MS SQLSERVER)

    Option Explicit

    Public Sub test2()

    Dim ado As adosql

    Set ado = New adosql

    ado.openDsn "driver={SQL Server};server=10.3.xxx.x;uid=sql;pwd=xxxx;database=TESTDB"

    Dim sqlstr As String

    sqlstr = "select isnull(sum(sodqty),0) from salesdetail where plantcode = 'CN01' and orddate >= ?"

    ado.inparadate 1, "@date", "2020-04-28"

    MsgBox (ado.scalar(sqlstr))

    ado.rlspara 3

    Set ado = Nothing

    End Sub

    这样就可以比较方便的取到数据 输出到EXCEL表格里了

    展开全文
  • 新增一个模块'class name: adosql for vba useOption ExplicitPrivate ObjConnection As New ADODB.ConnectionPrivate ObjCommand As New ADODB.CommandPublic ObjRecordSet As New ADODB.Recor...

    1.首先Excel要引用相应的ActiveX库

    2.新增一个类模块

    'class name: adosql for vba use

    Option Explicit

    Private ObjConnection As New ADODB.Connection

    Private ObjCommand As New ADODB.Command

    Public ObjRecordSet As New ADODB.Recordset

    Private para(16) As New ADODB.Parameter

    Private Sub class_initialize() '构造函数

    ObjConnection.CommandTimeout = 15

    ObjConnection.ConnectionTimeout = 15

    End Sub

    Public Sub openDsn(strDSN As String) '打开数据库连接

    If Len(strDSN) = 0 Then

    MsgBox "DSN不能为空."

    Exit Sub

    End If

    If Right(strDSN, 1) = ";" Then

    ObjConnection.Open strDSN

    Else

    ObjConnection.Open strDSN & ";"

    End If

    End Sub

    Public Sub setCmd(strQUERY As String, cmdTYPE As Integer) '设置命令

    ObjCommand.ActiveConnection = ObjConnection

    ObjCommand.CommandText = strQUERY

    ObjCommand.CommandType = cmdTYPE '1-语句 4-存储过程

    ObjConnection.CursorLocation = 3 '本地游标库提供的客户端游标

    ObjRecordSet.CursorType = 3 '静态游标

    End Sub

    Public Sub inpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 1, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparastr(s As Integer, paname As String, palen As String, pavalue As String) '参数个数 参数名 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, "202", 1, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparaint(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "3", 1, "8", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparadate(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "7", 1, "10", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparabool(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "11", 1, "1", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inparadec(s As Integer, paname As String, pavalue As String) '参数个数 参数名 值

    Set para(s) = ObjCommand.CreateParameter(paname, "14", 1, "18", pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub outpara(s As Integer, paname As String, paformat As String, palen As String) '参数个数 参数名 字符类型 长度

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 2, palen)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Sub inoutpara(s As Integer, paname As String, paformat As String, palen As String, pavalue As String) '参数个数 参数名 字符类型 长度 值

    Set para(s) = ObjCommand.CreateParameter(paname, paformat, 3, palen, pavalue)

    ObjCommand.Parameters.Append para(s)

    End Sub

    Public Function outvalue(s As Integer) As String '返回指定参数返回值

    outvalue = para(s).Value

    End Function

    Public Sub rlspara(s As Integer) '释放参数对象

    Dim i As Integer

    For i = 1 To s

    ObjCommand.Parameters.Delete para(i).Name

    Set para(i) = Nothing

    Next

    End Sub

    Public Function execRT() As Integer '执行CMD 并返回记录数

    Set ObjRecordSet = ObjCommand.Execute

    execRT = CInt(ObjRecordSet.RecordCount)

    End Function

    Public Function getRT() As ADODB.Recordset '返回记录集

    Set getRT = ObjCommand.Execute

    End Function

    Private Sub mfirst() '游标定位到第一条

    ObjRecordSet.MoveFirst

    End Sub

    Private Sub mnext() '游标定位到下一条

    ObjRecordSet.MoveNext

    End Sub

    Public Function getvalue(fieldname As Integer) As String '取值 BY name

    getvalue = ObjRecordSet.Fields(fieldname).Value

    End Function

    Public Function numvalue(fieldnum As Integer) As String '取值 BY number

    numvalue = ObjRecordSet.Fields(fieldnum).Value

    End Function

    Public Sub clsrcd() '关闭结果集

    ObjRecordSet.Close

    End Sub

    Public Sub clscon() '关闭连接

    ObjConnection.Close

    End Sub

    Public Function scalar(strQUERY As String) As String '返回字符串值

    Dim ct As Integer

    Call setCmd(strQUERY, 1)

    ct = execRT()

    If ct > 0 Then

    Call mfirst

    scalar = numvalue(0)

    Else

    scalar = ""

    End If

    Call clsrcd

    End Function

    Public Sub rlscon() '释放所有对象

    Set ObjRecordSet = Nothing

    Set ObjCommand = Nothing

    if ObjConnection.State = adStateOpen Then

    ObjConnection.Close

    endif

    Set ObjConnection = Nothing

    End Sub

    Private Sub Class_Terminate() '析构函数

    Set ObjRecordSet = Nothing

    Set ObjCommand = Nothing

    if ObjConnection.State = adStateOpen Then

    ObjConnection.Close

    endif

    Set ObjConnection = Nothing

    End Sub

    3.新增一个SUB在模块里

    测试连接数据库(PROGRESS)

    Option Explicit

    Public Sub test1()

    Dim ado As adosql

    Set ado = New adosql

    ado.openDsn "Dsn=mfgtest;uid=sql;pwd=123;host=xxx.xx.xx.xx;port=xxxx;db=mfgdb;"

    Dim sqlstr As String

    sqlstr = "select ifnull(sum(op_qty_comp),0) from pub.op_hist where op_domain = 'CN01' and op_site = 'CN01' and op_type = 'BACKFLSH' and op_date = ? and op_part = ? and op_wo_op = ?"

    ado.inparadate 1, "@date", "2020-04-28"

    ado.inparastr 2, "@part", "18", "ABC0001"

    ado.inparaint 3, "@op", "40"

    MsgBox (ado.scalar(sqlstr))

    ado.rlspara 3

    Set ado = Nothing

    End Sub

    测试连接数据库(MS SQLSERVER)

    Option Explicit

    Public Sub test2()

    Dim ado As adosql

    Set ado = New adosql

    ado.openDsn "driver={SQL Server};server=10.3.xxx.x;uid=sql;pwd=xxxx;database=TESTDB"

    Dim sqlstr As String

    sqlstr = "select isnull(sum(sodqty),0) from salesdetail where plantcode = 'CN01' and orddate >= ?"

    ado.inparadate 1, "@date", "2020-04-28"

    MsgBox (ado.scalar(sqlstr))

    ado.rlspara 3

    Set ado = Nothing

    End Sub

    这样就可以比较方便的取到数据 输出到EXCEL表格里了

    展开全文
  • 大家好,到上一讲,我们学习了有关的定义部分,涉及到的概念较多,需要大家仔细地理解。我们今日这讲,将用户自定义事件。我们建立了,通过对象把进行了实例化,把灵魂具体到了了肉身,我们就要让这个实例的...

    9f14257a935f4de4b1c2d355966bfa91.png

    大家好,到上一讲,我们学习了有关类的定义部分,涉及到的概念较多,需要大家仔细地理解。我们今日这讲,将用户自定义事件。我们建立了类,通过对象把类进行了实例化,把灵魂具体到了了肉身,我们就要让这个实例的对象参与各种事件了,由于类是我们自己进行的定义,那么实例的对象要参与的事件我们也是能自己定义的。

    定义用户自定义的事件的语法:[Public] Event procedurename [(arglist)]

    上述参数中:

    1 Public 可选的。指定该 Event 在整个工程中都是可见的。缺省情况下 Events 类型是 Public。应注意,事件只能在所声明的模块中产生。

    2 procedurename 必需的。事件的名称;建议大家遵循标准的变量命名约定,但我们也可以自己加入自己的部分习惯。

    3 arglist 参数的语法及语法的各个部分如下:[ByVal | ByRef] varname[( )] [As type]

    其中:

    ①ByVal 可选的。表示该参数是按值传递的;

    ②ByRef 可选的。表示该参数是按地址传递的。ByRef 是缺省设置。

    ③varname 必需的。代表要传递给过程的参数变量的名称;遵循标准的变量命名约定。

    ④type 可选的。指传递给过程的参数的数据类型;可以是 Byte、布尔、Integer、Long、Currency、Single、Double、Decimal(目前尚不支持)、Date、String(只支持变长)、Object、Variant、用户定义类型或对象类型。

    说明:

    1 事件被声明之后,就可以使用RaiseEvent 语句来产生该事件。

    2 声明事件只能在类模块中声明,如果在标准模块中出现 Event 声明,就会产生语法错误。这也好理解,事件是对我们产生的对象进行的声明,对象是由类产生的。

    3 不能声明带返回值的事件。在下面的代码段中,给出了声明事件和产生事件的典型事件:

    如下语句:在类模块的模块级中声明一个事件,及触发一个事件:

    Public Event UpdateTime(ByVal mynow As Double) SubRaiseEvent

    RaiseEvent UpdateTime(Timer - myStart)

    注意 可以象声明过程的参数一样来声明事件的参数,但有以下不同:事件不能有带命名参数、Optional参数、或者 ParamArray 参数。事件没有返回值。

    产生事件的类是事件源,实现该事件的类则是事件吸收。一个事件源可以有多个针对其所产生的事件的类。事件可以被每个选定出为对象的实例吸收事件的类所触发。

    实例:下面的示例实现一个计时器功能。代码说明了所有与事件相关的方法、属性和语句,包括Event 语句。

    该示例使用一个窗体,该窗体有两个按钮,以及两个文本框。单击按钮后,第一个文本框显示提示内容,第二个文本框中时钟开始计时。

    建立一个类,命名为mytime

    Option Explicit

    Public Event UpdateTime(ByVal mynow As Double)

    Public Event dabiao()

    Public Sub TimerTask(ByVal biaozhun As Double)

    Dim myStart As Double

    Dim mySecond As Double

    Dim myFar As Double

    myStart = Timer

    myFar = myStart

    Do While Timer < myStart + biaozhun

    If Timer - myFar >= 1 Then

    myFar = myFar + 1

    RaiseEvent UpdateTime(Timer - myStart)

    End If

    Loop

    RaiseEvent dabiao

    Do While Timer >= myStart + biaozhun

    If Timer - myFar >= 1 Then

    myFar = myFar + 1

    RaiseEvent UpdateTime(Timer - myStart)

    End If

    Loop

    End Sub

    建立一个窗体:

    0adbf00797589d70d97fb0055ca285f1.png

    Option Explicit

    Private WithEvents mText As mytime

    Private Sub CommandButton1_Click()

    TextBox1.Text = "开始计时:"

    TextBox2.Text = "0"

    mText.TimerTask (9)

    End Sub

    Private Sub CommandButton2_Click()

    End

    End Sub

    Private Sub mText_dabiao()

    TextBox1.Text = "已经达到标准"

    DoEvents

    End Sub

    Private Sub mText_UpdateTime(ByVal mynow As Double)

    TextBox2.Text = Str(Format(mynow, "0"))

    DoEvents

    End Sub

    Private Sub UserForm_Initialize()

    TextBox1.Text = ""

    TextBox2.Text = ""

    Set mText = New mytime

    End Sub

    Private Sub UserForm_Terminate()

    End

    End Sub

    代码的运行过程及解释:

    1 在窗体的构建过程中TextBox1.Text = "";TextBox2.Text = "";Set mText = New mytime;这里mytime 是一个类,Set mText = New mytime就是将mText实例了一个新的mytime的类。

    2 我们点击“开始按钮”,这个时候TextBox1.Text = "开始计时:",然后在第二个文本框中显示计时的开始为0, TextBox2.Text = "0",然后执行类的TimerTask过程,(什么是过程呢?其实就是方法,函数,事件的总称).此处的过程指的是方法,会传递一个参数9,mText.TimerTask (9)。

    3 我们看看上述类的过程是如何执行的. mText.TimerTask (9)

    Public Sub TimerTask(ByVal biaozhun As Double)

    Dim myStart As Double

    Dim mySecond As Double

    Dim myFar As Double

    myStart = Timer

    myFar = myStart

    Do While Timer < myStart + biaozhun

    If Timer - myFar >= 1 Then

    myFar = myFar + 1

    RaiseEvent UpdateTime(Timer - myStart)

    End If

    Loop

    RaiseEvent dabiao

    Do While Timer >= myStart + biaozhun

    If Timer - myFar >= 1 Then

    myFar = myFar + 1

    RaiseEvent UpdateTime(Timer - myStart)

    End If

    Loop

    End Sub

    上面的过程中先定义了几个变量,然后将执行一个循环,循环执行到RaiseEvent UpdateTime(Timer - myStart)会触发事件UpdateTime(Timer - myStart).

    4 关于UpdateTime(Timer - myStart)事件.这个事件是在类模块中Public Event UpdateTime(ByVal mynow As Double)进行声明的相应的是myclass事件,我们回到窗体的代码,看看这个事件的过程。

    Private Sub mText_UpdateTime(ByVal mynow As Double)

    TextBox2.Text = Str(Format(mynow, "0"))

    DoEvents

    End Sub

    这个事件就是在textbox2的文本框中显示一个值,这个值是TimerTask传递过来的.显示值后,会DoEvents。交出程序的控制权,也就是说程序会向下进行。

    5 程序向下进行仍是执行的是第一个循环语句。

    6 当第一个循环语句结束时,会执行RaiseEvent dabiao,会触发dabiao事件,这个事件同样也是在类模块中声明的Public Event dabiao(),是mText的事件。仍是回到窗体代码看看这个事件过程:

    Private Sub mText_dabiao()

    TextBox1.Text = "已经达到标准"

    DoEvents

    End Sub

    这个世界在文本框中显示已经达到标准。执行完后交出程序的控制权。

    7 程序执行完上面的代码后将向下执行第二个循环。这个循环和上面第一个循环类似。

    好,我们看看程序的运行:

    84b34092a0752978a89357a7b252b83e.png

    56714945ec9df81c8eaae03108a5fb08.png

    当点击结束,程序将停止运行。

    ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

    学习有用的东西需要一种不知足的精神,知道什么是自己所需要的,不要蜷缩在一小块自认为天堂的世界里。待到暮年时再去做自欺欺人的言论。要努力提高自己,有一颗充满生机的心灵,把握现在,这才是进取。越是有意义的事情,困难会越多。愿力决定始终,智慧决定成败。不管遇到什么,都是风景。看淡纷争,看轻得失。茶,满也好,少也好,不要计较;浓也好,淡也好,其中自有值得品的味道。去感悟真实的时间,静下心,多学习,积累福报。而不是天天混日子,也不是天天熬日子。在后疫情更加严峻的存量残杀世界中,为自己的生存进行知识的储备,特别是新知识的储备。

    VBA是利用Office实现自己小型办公自动化的有效手段,我根据自己20多年的VBA实际利用经验,现在推出了五部VBA教程。第一:VBA代码解决方案,是VBA中各个知识点的讲解,覆盖绝大多数的VBA知识点;第二:VBA数据库解决方案,是数据处理的专业利器,详细的介绍了利用ADO连接ACCDB和EXCEL的方法和实例操作。第三:VBA数组与字典解决方案,讲解VBA中的数组和字典的利用。字典是VBA代码水平提高的手段,值得深入的学习。第四:VBA代码解决方案之视频,是专门面向初学者的视频讲解,可以快速入门,更快的掌握这门技能。第五:VBA中类的解读和利用,是一部高级教程,对于自己理论的提高很有益处。上述教程可以根据1,3,2,5或者是4,3,2,5的顺序逐渐深入的学习和利用。

    在取代OFFICE新的办公软件没有到来之前,谁能在数据处理方面做到极致,谁就是王者。其中登峰至极的技能非VBA莫属!

    今日内容回向:

    1 如何利用一个类的方法?

    2 方法、事件的区别是什么?

    展开全文
  • 想了解一下VBA自定义类和事件,以及注册事件处理程序的方法。 折腾了大半天,觉得这样的方式实在称不上“注册”,所以加一个“伪”字。纯粹是瞎试,原理也还没有摸透。先留着,有时间再接着摸。 做以下尝试: 1...

    想了解一下VBA中自定义类和事件,以及注册事件处理程序的方法。

    折腾了大半天,觉得这样的方式实在称不上“注册”,所以加一个“伪”字。纯粹是瞎试,原理也还没有摸透。先留着,有时间再接着摸。

    做以下尝试:

    1、建一个自定义类(类模块),类名:Qiqiu

        该类提供一个Daqi的方法,每执行一次,x(记录气球的体积)的值+i,如果x的值大于max,则触发自定义的Change事件。

        为节省细节不使用属性过程,变量直接用public

     1 Public Event Change(q As qiqiu)   'Event关键字声明事件,事件参数是Qiqiu类型。 
    '推模式还是拉模式?一直感觉有参数的都该是推模式,傻傻分不清楚啊。 2 Public x As Integer '记录实际体积 3 Public max As Integer '记录最大体积 4 Function Daqi(i As Integer) '模拟给Qiqiu打气的情形 5 x = x + i 6 If x > max Then 7 RaiseEvent Change(Me) 'RaiseEvent关键字触发事件。在事件触发时,把自已的实例引用传给订阅者。 8 x = 0 9 End If 10 End Function

    2、建三个简单窗体MainFrm,UserFrm1,UserFrm2

        MainFrm启动后,点击“弹出窗体按钮”,UserFrm1和UserFrm2显示出来

       

    3、UserFrm1、UserFrm2需要关联Qiqiu的Change事件(观察气球状态的变化对事件做出响应),需要做一些准备

        下面是UserFrm1中的代码(为简化案例,UserFrm2的代码和UserFrm1完全相同,实际上可以完全是不同的响应)

        注意第一行的WithEvents关键字的变量声明,后面需要使用这个变量将方法(事件处理程序)关联到事件。

    1 Public WithEvents qiu As Qiqiu          '关联Qiqiu的事件的关键,维护一个Qiqiu的引用,既然有引用,本案的Change事件的参数就显得很多余。
    2 
    3 Private Sub qiu_Change(q As Qiqiu)      '事件的响应程序
    4 Me.TextBox1 = "气球爆炸了,爆炸时体积是:" + CStr(q.x) 5 End Sub

    4、MainFrm主窗体代码:

     1 Public q As Qiqiu 
     3 Private Sub UserForm_Initialize()
     4     Set q = New Qiqiu                      '窗体初始化,初始化Qiqiu类的实例
     5     q.max = 10                             '将q的最大体积设定为10
     6 End Sub
     8 
     9 Private Sub btn_Click()              '点击按钮“弹出窗体”执行的代码,实例化UserFrm1和UserFrm2并显示 
    11 Dim f1 As UserFrm1, f2 As UserFrm2
    13   Set f1 = New UserFrm1
    14   Set f2 = New UserFrm2
    16   Set f1.qiu = q        '第3中的WithEvents关键字声名的变量在此处使用
    17   Set f2.qiu = q        '使f1.qiu,f2.qiu分别指向Qiqiu类的实例q(即:注册)
    19     f1.Show False
    20     f2.Show False
    22 End Sub
    23 
    24 Private Sub btndq_Click()          '点击按钮“打气”执行的代码   
    26      q.daqi (5)                    '调用q的打气方法给Qiqiu打气,每次打入气体体积为5。当q.x大于q.max时触发事件  
    28 End Sub

     5、程序执行效果:(虽然实现了效果,但理解上感觉模模糊糊)

          打气三次时触发事件(此时气球的体积是15,超过了气球的max体积10),事件关联的处理程序提示,气球爆炸,并获取爆炸时的体积

        

    6、小结:

         VBA中,类的事件可能是很封闭的。不像C#事件开放了注册和移除的接口,只要方法签名相同,就可以很方便的指向事件的响应方法,根本不需要在订阅者类的内部再声明和发布者直接相关东西(变量引用),减小耦合度。

         其实摸索了VBA的对象浏览器后,也可以找到类中事件的冰山一角,可以看到它的签名。比如Worksheet的Change事件。

        

    7、补充一点转来的总结(我自己按想法修改了一些用词):

        主题对象(被观察者、事件发布者)对客户端(观察者、订阅者)一无所知

    1. 观察者引用一个主题对象,对这个观察者,它可将引用放置在 WithEvents 变量中来处理那些主题对象。发布者没有订阅者的信息。它向未知数目的听众进行广播, 剧院中可能一个观众都没有。
    2. 主题对象不会控制接收事件的观察者的次序。(好像这点和C#有很大不同,C#事件注册的顺序可以决定事件的执行顺序)
    3. 当对象引发事件时,其所有订阅者都在引发事件的对象再次获得控制之前处理该事件。
    4. 如果事件包含 ByRef 参数,则该参数可被任何处理事件的客户程序改变。只有最后的客户端进行的改变才对引发事件的对象可见,因为(如上所述),直到所有客户端都处理该事件之前,引发事件的对象不会再度获得控制。

        为了将某个事件添加到一个类中,然后使用该事件,可以这样做:

    1. 在定义类的类模块声明部分,用 Event 语句来声明事件—该事件带有希望它带有的任何参数。事件总是 Public。 注意 事件不能有命名的参数、Optional可选的参数、或 ParamArray可变参数。事件没有返回值。
    2. 在类模块代码中的合适地方,用 RaiseEvent 语句来引发事件,并提供所需要的参数。
    3. 在将要处理事件的模块声明部分,使用 WithEvents 关键字,添加该类类型的变量。它必须是一个模块级的变量。
    4. 在代码窗口左边的下拉菜单上,选择声明为 WithEvents 的变量。
    5. 在代码窗口右边的下拉菜单上,选择希望处理的事件。(可以为类声明多个事件。)
    6. 使用所提供的参数,将代码添加到事件过程中。

    转载于:https://www.cnblogs.com/zzstone/p/5521296.html

    展开全文
  • 分享成果,随喜真能量。大家好,今天继续和大家分享VBA编程中...下面是我根据自己20多年的VBA实际利用经验,编写的四部经验教程,这些是较大块的“积木”,可以独立的完成某些或者某系统的过程,欢迎有需要的朋友...
  • 细品RibbonX(39):技巧—使用VBA自定义功能区元素属性资料整理来自于论坛完整版下载地址:http://download.csdn.net/download/nodeman/10264659 Loading ... 除了使用创建自定义属性外,也可以为许多对象(例如...
  • 之前群里讨论过,为什么基础Excel函数教程之的会成为月经首页热门,得到的结论是:基础用户比较多,看到了就想着说,以后说不定有用吧,点了收藏。所以更高阶一点的东西,比如VBA,讨论结果是不会有什么热度,因为...
  • 75.删除单元格自定义名称 76.从文件路径中取得文件名 77.取得一个文件的扩展名 78.取得一个文件的路径 79.十进制转二进制 80.检查一个数组是否为空 81.字母栏名转数字栏名 82.数字栏名转文字栏名 83.判断一件活页夹...
  • VBA中, 模块相当于C语言中的模板要单独放到模块中(自定义类型和子过程放在模块中),模板的名称就是的名称,可以做为新的类型进行声明和定义。1 自定义类型的声明和使用1.1 自定义类型的声明Public ...
  • 不同类型的变量可以组合起来用来创建用户定义的类型(如熟知的 C 编程语言中的 structs)。当需要创建单个变量来记录多项相关的信息时,用户定义类型是十分有用的。 可以用 Type 语句创建用户定义的类型,该...
  • 1.最近对Excel文件使用较为频繁,故写了几个函数,通过调用可以实现一些基本功能,仅供参考: (1)遍历指定文件夹下所有文件,并获得文件名(如需要获得指定的文件类型,请增加一个判断条件来判断文件类型) ...
  • 将永恒君的百宝箱设为星标精品文章第一...他研究的样品一共有三种,标记为s,d,f三。他需要做的事情是:右手边查看样品,左手在Excel中做记录(即样品对应的单元格中输入s,d,f三个字母中的一个,同时单元格标记颜...
  • 函数作用:删除单元格自定义名称.....................88 '76.函数作用:从文件路径中取得文件名...................89 '77.函数作用:取得一个文件的扩展名.....................89 '78.函数作用:取得一个文件的路径.....
  • 大家好,我们今天继续讲解的相关知识。在上一讲中我们讲了使用WithEvents定义响应事件的对象,那么有了对象自然要跟进到事件了,这讲就给大家讲解两个新...这套VBA的解读及应用中,侧重点是理论的学习,要求大...
  • vba 嵌套示例

    千次阅读 2010-03-14 16:02:00
    t1: 自定义类 略 t2 Private m_t1 As t1 Public Property Get t1() Set t1 = m_t1 End Property Public Property Set t1(value As t1) Set m_t1 = value End Property Private Sub Cla
  • VBA类模块封装2018-09-26"封装宏-------------------------Sub 表达式变公式()Dim g As New 功能库g.公式变数值 Range("b3")g.自定义格式变数值 Range("c3")g.表达式变公式 Range("d3")End SubSub 删除重复值()Dim ...
  • 上次我介绍了有规律字符串的提取...今天我就来给大家介绍解决这问题的一种方法-使用excel的自定义函数。相对而言对excel的技能要求有所提高,但掌握了之后,会提升和拓宽你使用excel解决问题的技能。 自定义函数需
  • VBA-Vector是一维数组的自定义实现,可以使编码过程更加舒适。 入门 下载,解压缩,然后将ClassVector.cls导入到您的VBA项目中。 初始化ClassVector新变量,并将标准数组(String,Variant,Double等)转换为此类...
  • 有一些项目中,偏好用excel进行数据收集和品质管理等。 针对每个机能就会有一套管理文件。制造review票,测试式样书,测试式样的review票,测试结果的...针对这问题,我觉得有必要设计一个VBA工具来辅助我们轻...
  • 例如,您可以使用 CustomCommand方法来执行表相关的命令,方法是使用 Table 开头的。 参数说明 参数 描述 ComponentID 指定所需组件的ID CommandID 指定所需命令的ID Parameter 指定所需的参数 ...
  • 根据自定义的某一列创建工作表项目分析需求分析解决思路及代码最终效果图知识点总结整体代码 项目分析 项目所在地址 位置:王佩丰 VBA 课件\第七课 需求分析 在处理财务数据时,可能需要根据某一行中的数据对整个...
  • 集合VBA集合对象的安全包装

    千次阅读 2014-01-01 07:08:14
    你迟早都要管理一组由VBA类模块创建的自定义对象,VBA Collection对象是实现这一目的的理想工具。我们在该杂志的Premiere期刊中曾经介绍过Collections,并且阐述了如何使用Collection对象来存储其他对象。虽然该项...
  • 1 filter() 函数的局限性 ...--为什么,因为filter的原理 if like Sub test110() 'Filter函数可以区分" " 即1个空格,但不能区分""空值或空白。 'filter() 非精确查找 'filter() 的原理是? ...
  • VBA中绕着圈子继承

    千次阅读 2008-12-05 14:21:00
    版权声明:可以任意转载,转载时请务必以超链接形式标明如下文章原始出处和作者信息及本声明作者:xixi出处:http://blog.csdn.net/slowgrace/archive/2008/12/05/3452804.aspxTechnorati 标签: ,继承,vba,自定义,...
  • 你已选中了添加链接的内容蓝字关注,加微信NZ9668获资料信息VBA解决方案 系列丛书作者头条百家平台 VBA资深创作者_______________________________大家好,我们今天继续讲解的相关知识。在上一讲中我们讲了使用...
  • VBA入门

    2017-12-06 09:21:10
    学习了一晚上的VBA入门视频,知道了如何打开Excel的vba代码编辑工具,office 2010需要在文件–>选项当中自定义功能区–>勾选开发工具。这样才能使用,不同的版本Excel有可能自带,貌似WPS需要安装插件。学习VBA,...
  • 一EXCEL和VBA的3种函数 1.1 EXCEL和VBA VBA是寄生在EXCEL里的 VBA有自己的原生函数 VBA. VBA的Application===EXCEL,本身各有很多各种函数。...VBA的函数: VBA内置函数,用户自定义函数: 写法可以省略vba. ...
  • 你迟早都要管理一组由VBA类模块创建的自定义对象,VBACollection对象是实现这一目的的理想工具。我们在该杂志的Premiere期刊中曾经介绍过Collections,并且阐述了如何使用Collection对象来存储其他...
  • EXCEL VBA的各种处理

    2018-06-27 15:59:08
    具体向读者讲述了vba语言基础,vba程序设计网络教学,xml与asp技术,利用vba操纵文件和文件夹,利用vba控制其它应用程序,自定义集合和模块,调试vba过程和处理错误等等,希望对网友们有帮助。
  • vba入门讲座

    2011-10-14 10:09:24
    vba开发入门指南【文档】 * VBA一个关键特征是你所学的知识在微软的一些产品中可以相互转化.  * VBA可以称作EXCEL的“遥控器”.  VBA究竟是什么?更确切地讲,它是一种自动化语言,它可以使常用的程序自动化,可以...

空空如也

空空如也

1 2 3 4 5 ... 11
收藏数 206
精华内容 82
关键字:

vba自定义类