VBA Fans

最近在Excel2010中试用一个以前写的Excel2003的做图工具时碰到一个ChartObject对象的命名错误，这个错误产生的名称在Excel2003中可以正常使用，但到Excel2010中则产生错误。这样发现Excel2003中的ChartObject对象命名的一个奇怪现象。

在Excel工作簿中，图表可以放在两个地方，一个是做为嵌入图表放在工作表里，另外一个是放在图表工作表里。这里讨论前一种情况。

每个图表由一个Chart对象代表，而包含这个Chart对象的就是ChartObject对象。ChartObject对象的属性和方法控制嵌入图表的外观和尺寸，而Chart对象的属性和方法控制图表的内容。

针对嵌入图表，我们可以使用Activate方法激活ChartObject对象，则它所包含的Chart对象也就处于活动状态。这时可以使用ActiveChart来引用这个Chart象。

每个ChartObject对象有一个Name属性，同时每个包含的Chart对象也有一个Name属性。ChartObject对象的名称可以改变，而Chart对象的名称不能修改。如果你改变工作表的名称，Chart对象的名称也会自动改变。

在Excel2003中，你可以通过下面的方法查看ChartObject对象的名称，按下“Ctrl”键，单击图表，在名称栏会显示所选图表的ChartObject对象的名称，并且图表的选择状态也发生了改变。如图：

在立即窗口中做下面的操作（这里是中文版的内容，英文版的结果有些不同）：
输入：?ActiveSheet.ChartObjects(1).Name
返回：Chart 1

输入：?ActiveSheet.ChartObjects(2).Name
返回：Chart 2

输入：?ActiveSheet.ChartObjects(1).Chart.Name
返回：Sheet1 图表 1

如果修改工作表的名称为Sheet2，Chart对象的名称会改成：
输入：?ActiveSheet.ChartObjects(1).Chart.Name
返回：Sheet2 图表 1

将ChartObject对象的名称改成中文，仍然返回”Chart 1″：
输入：?ActiveSheet.ChartObjects(“图表 1″).Name
返回：Chart 1

在ChartObject对象的名称前加一个空格或多个空格，仍然返回”Chart 1″：
输入：?ActiveSheet.ChartObjects(” Chart 1″).Name
返回：Chart 1
输入：?ActiveSheet.ChartObjects(” Chart 1″).Name
返回：Chart 1

在ChartObject对象的名称前加一个”1″，仍然返回”Chart 1″：
输入：?ActiveSheet.ChartObjects(“1Chart 1″).Name
返回：Chart 1
如果前面加了一个”1″，后面跟任何一个字符都可以返回”Chart 1″：
输入：?ActiveSheet.ChartObjects(“1D”).Name
返回：Chart 1

在ChartObject对象的名称前加”1″和多个空格，仍然返回”Chart 1″：
输入：?ActiveSheet.ChartObjects(“1 Chart 1″).Name
返回：Chart 1

输入：?ActiveSheet.ChartObjects(” 1 Chart 1″).Name
返回：Chart 1

但是在”Chart 1″前加上”2″，却返回”Chart 2″：
输入：?ActiveSheet.ChartObjects(“2Chart 1″).Name
返回：Chart 2

在”Chart 2″前加上”2″，也返回”Chart 2″：
输入：?ActiveSheet.ChartObjects(“2Chart 2″).Name
返回：Chart 2

假如工作表中只有两个图表，输入”3Chart 2″则出现错误。

接着来：
如果在立即窗口中输入下面的语句将第1个ChartObject对象的名称改成”Chart 2″。
ActiveSheet.ChartObjects(“Chart 1″).Name=”Chart 2″

在立即窗口你会发现还是可以使用”Chart 1″来指定第1个ChartObject对象，返回的名称却是”Chart 2″：
输入：?ActiveSheet.ChartObjects(“Chart 1″).Name
返回：Chart 2

如果在立即窗口中输入下面的语句将第2个ChartObject对象的名称改成”Chart 3″。
ActiveSheet.ChartObjects(2).Name=”Chart 3″

输入：?ActiveSheet.ChartObjects(“Chart 1″).Name
返回：Chart 2
输入：?ActiveSheet.ChartObjects(“Chart 2″).Name
返回：Chart 2
输入：?ActiveSheet.ChartObjects(“Chart 3″).Name
返回：Chart 3

但是
输入：?ActiveSheet.ChartObjects(“2Chart 2″).Name
返回：Chart 3

上面的这些名称变化使用的是”Chart *”，并不影响使用ChartObjects(“图表 1″)的表示方式，而使用”图表 *”来表示的话同样有上面这些变化。

这些ChartObject的名称变化并不影响其中的Chart对象的名称。总的来说，感觉ChartObject对象在处理名称时忽略了前后的空格。忽略空格后第一个字符是数字的话，则以这个数字作为序号来处理。剩下的名称定义一时没搞明白是怎么处理的。

前面说这么多，其实最终的结论是使用名称来定义ChartObject对象并不是很准确，建议使用序列号并结合Chart对象的名称来准确地定义ChartObject对象。

还好在Excel2007和Excel2010中，这种情况得到了改善。
Excel2007和Excel2010中，查看图表的名称，可以激活图表，然后选择菜单”图表工具“-〉”布局“，单击工具栏”属性“，可以在下拉窗口中看到图表名称，如下图：

在中文版的Excel2010中，可以使用ActiveSheet.ChartObjects(“图表 1″).Name或者ActiveSheet.ChartObjects(“Chart 1″).Name来表示ChartObject对象的名称，但不能在名称前和Excel2003一样添加空格和数字。

但是在Excel2007和Excel2010中仍然将两个图表的ChartObject对象定义成相同的名称。例如在输入下面的语句改变第一个图表的ChartObject对象的名称为”Chart 2″。
ActiveSheet.ChartObjects(“Chart 1″).Name=”Chart 2″

然后在立即窗口
输入：?ActiveSheet.ChartObjects(1).Name
返回：Chart 2

输入：?ActiveSheet.ChartObjects(2).Name
返回：Chart 2

注意：和Excel2003不同的是，Chart对象的名称也一起改变。
输入：?ActiveSheet.ChartObjects(1).Chart.Name
返回：Sheet1 Chart 2
输入：?ActiveSheet.ChartObjects(2).Chart.Name
返回：Sheet1 Chart 2

VBA Chart, Excel, VBA

在这篇文章中介绍了使用VBA操纵Lotus Notes的一些功能。刚刚回答了EH会员的一个关于打印Lotus Notes邮件的问题，感觉比较特殊，记录到这里。

Lotus OLE自动化服务器提供了两个OLE自动化对象。Notes.NotesUIWorkspace提供对Domino UI对象的访问，而Notes.NotesSession提供对Domino对象（后台对象）的访问。

分别对应于以上两个对象，邮件也有相对应的NotesUIDocument和NotesDocument对象。但是只有NotesUIDocument对象才有Print方法。因此打印NotesDocument对象时需要它先转换为NotesUIDocument对象。这个转换
如下：

Set ws = CreateObject("Notes.NotesUIWorkspace")
Set s = CreateObject("Notes.NotesSession")
Set db = s.CURRENTDATABASE
Set dc = db.ALLDOCUMENTS
Set doc = dc.GETFIRSTDOCUMENT
Set uidoc = ws.EDITDOCUMENT(False, doc, False, , False)
uidoc.EDITMODE = False

转换后就可以使用uidoc.Print方法。但是运行时你会发现出现错误提示对象不支持该属性或方法。
而输入Call uidoc.Print回车后代码会自动改成uidoc.Print，即使添加参数仍然会出现上述错误。

而在立即窗口输入?uidoc.Print则可以在Lotus Notes中出现打印窗口。这个不知道是什么原因。修改后正确的代码（使用Debug.Print）如下：

Set ws = CreateObject("Notes.NotesUIWorkspace")
Set s = CreateObject("Notes.NotesSession")
Set db = s.CURRENTDATABASE
Set dc = db.ALLDOCUMENTS
Set doc = dc.GETFIRSTDOCUMENT
Set uidoc = ws.EDITDOCUMENT(False, doc, False, , False)
uidoc.EDITMODE = False
On Error Resume Next
Debug.Print uidoc.Print

如果你想不提示打印窗口而直接打印的话，可以给Print方法添加参数，例如：

Debug.Print uidoc.Print(0,0,0,false)

VBA Email, Excel, Lotus Notes, VBA

最近很久没有更新。

在Excel中发送邮件有很多方式，可以使用Outlook，或者使用Lotus Notes。这里使用CDO组件来，CDO组件包括在cdosys.dll这个动态链接库中。关于CDO的文章，网络上已经有很多资源。

这个加载宏使用CDO组件来直接发送邮件，这样不需要Outlook或Lotus Notes这些外部程序。而且使用Outlook时，会有一个烦人的提示窗口。

使用CDO组件发送邮件的前提是你的邮箱支持SMTP服务。

界面：

设置：

发送界面：

下载：Box.net | SkyDrive

VBA Addin, Excel, VBA, 工具

VB中的Timer控件提供了很好的计时器功能，VBA的原始功能中没有包括Timer控件，取而代之的是Application.OnTime方法，但是在定时重复运行某个过程的情况下OnTime方法使用并不太方便。

简单的API Timer函数

使用API函数同样可以实现类似的OnTime功能，并且可以方便的循环运行指定的程序。只需要两个简单的API函数SetTimer和KillTimer。

Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Public lTimerID As Long
 
Sub StartTimer(lDuration As Long)
    If lTimerID = 0 Then
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
    Else
        Call StopTimer
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
    End If
End Sub
Sub StopTimer()
    KillTimer 0&, lTimerID
End Sub
Sub OnTime()
    ' 计时器触发后运行的代码放在这
    ' ...
    Cells(1, 1) = Now
End Sub

示例下载：Box | SkyDrive

单个事件的Timer类

我们也可以用这两个API函数创建一个类来完全模拟VB中Timer控件的方法，同时实现事件触发。这样做有一个困难，在类模块中不能使用AddressOf函数。一种方法是利用标准模块来获取回调函数的地址然后再类模块中调用。
创建一个名称为clsTimer的类模块，代码如下：

Option Explicit
 
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Private bEnable As Boolean
Private lDuration As Long
Private lTimerId As Long
 
Public Event Timer()
 
Public Property Let Enabled(ByVal vData As Boolean)
    bEnable = vData
    If bEnable = True Then
        StartTimer
    Else
        EndTimer
    End If
End Property
 
Public Property Get Enabled() As Boolean
    Enabled = bEnable
End Property
 
Public Property Let Interval(ByVal vData As Long)
    If vData < 0 Then vData = 0
    lDuration = vData
    If lDuration > 0 And bEnable = True Then
        EndTimer
        StartTimer
    End If
End Property
 
Public Property Get Interval() As Long
    Interval = lDuration
End Property
 
Private Sub Class_Initialize()
    bEnable = False
    lDuration = 0
    lTimerId = 0
End Sub
 
Private Sub Class_Terminate()
    EndTimer
    bEnable = False
    lDuration = 0
    lTimerId = 0
End Sub
 
Friend Sub cRaiseEvent(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lEventID As Long, ByVal dwTime As Long)
    If lEventID = lTimerId Then
        RaiseEvent Timer
    End If
End Sub
 
Private Sub StartTimer()
    If bEnable = True And lDuration > 0 Then
        lTimerId = SetTimer(0&, 0&, lDuration, GetAddressof(Me))
    End If
End Sub
 
Private Sub EndTimer()
    If lTimerId Then
        KillTimer 0&, lTimerId
        lTimerId = 0
    End If
End Sub

然后创建一个标准模块，代码如下：

Public modTimer As clsTimer
 
' 获取Timer Callback函数的地址
Public Function ReturnAddress(lpAddress As Long) As Long
    ReturnAddress = lpAddress
End Function
 
' Timer callback函数
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Call modTimer.cRaiseEvent(hwnd, uMsg, idEvent, dwTime)
End Sub
 
Public Function GetAddressof(myTimer As clsTimer) As Long
    Set modTimer = myTimer
    GetAddressof = ReturnAddress(AddressOf TimerProc)
End Function

要使用类模块的事件，只能在工作表或窗体这些类模块中调用clsTimer类。声明时需要使用WithEvents。

Private WithEvents cTimer1 As clsTimer

这个方法在只有一个clsTimer类实例时能很好的运行，但是当创建两个实例时，只有第二个实例的事件可以触发（不知道是不是类模块的代码写得不对或者还是其它原因，应该和标准模块中的回调函数TimerProc的地址有关，不同的类实例对应的这个回调函数的地址是一样的，这样可能导致始终只有最后一个声明的类实例能触发事件）。
示例下载：Box | SkyDrive

完整功能的Timer类

EH的Joforn发了一个挖雷的游戏，完全模拟Windows自带挖雷游戏的功能，里面使用了Paul Caton的类模块Call Back函数。使用这个类模块CallBack函数，可以在类模块中实现AddressOf函数的功能，因此可以实现多个clsTimer类实例的事件触发。

新的clsTimer类实现了和VB中Timer控件完全一样的功能。
属性：
Enabled：Boolean类型；设为True，启动计时器；设为False，则关闭计时器，默认为False。
Interval：Long类型；计时器间隔时间，单位为毫秒，默认为0。
事件：
Timer

示例下载：Box | SkyDrive

注意：使用以上的类模块，切记在退出Excel工作簿之前关闭clsTimer类，否则会导致Excel崩溃。

VBA Class, Timer, VBA

大家都知道，VBA中自带的MsgBox不能自动关闭，某些特殊情况下需要在指定时间内用户没有点击消息框按钮后能继续运行代码，需要用到定时关闭的消息框，之前的方法是使用Wscript.Shell的Popup方法，或者自定义窗体。
EH的ldy兄推荐了一个未公开的API可以实现定时关闭消息框，感觉十分有用。稍作修改，将wType参数改成可以提示输入VBA的vbMsgboxStyle常数。
这个API函数的参数如下：

• hwnd：窗口句柄，可以设为0
• lpText：消息框显示内容，类似于MsgBox函数的第一个参数Prompt
• lpCaption：消息框标题，类似于MsgBox函数的第三个参数Caption
• wType：消息框类型，类似于MsgBox函数的第二个参数Buttons
• wlange：不是太明白这个参数，0或者1都看不出什么差别
• dwTimeout：延时时间，单位是毫秒

返回的值和vbMsgBoxResult常数一样，多了一个返回值32000表示超过延时时间未选择任何按钮。

Private Declare Function MsgBoxEx Lib "user32" Alias "MessageBoxTimeoutA" ( _
    ByVal hwnd As Long, _
    ByVal lpText As String, _
    ByVal lpCaption As String, _
    ByVal wType As VbMsgBoxStyle, _
    ByVal wlange As Long, _
    ByVal dwTimeout As Long) As Long
Private Sub TestMsgboxEx()
    Dim ret As Long
    ret = MsgBoxEx(0, "请选择", "两秒后自动关闭", vbYesNo + vbInformation, 1, 2000)
    If ret = 32000 Then
        Debug.Print "超时关闭"
    ElseIf ret = vbYes Then
        Debug.Print "选择Yes"
    ElseIf ret = vbNo Then
        Debug.Print "选择No"
    End If
End Sub

VBA API, VBA