仿Excel 关闭前保存文档对话框（一）

 在Excel中当用户更改了一个文档之后在关闭文档时就会显示一个询问用户是否保存文档的对话框，但此对话框的标题和显示消息总是一成不变的，久了就会觉得没有味道。而且当用户在工作薄的Workbook_BeforeClose过程中设置了代码时，即使用户了点击询问对话框的“取消”按钮来取消关闭文档的操作时，你也会发现Workbook_BeforeClose过程的中的代码已经被执行，用户的很多设置已经被更改。而这往往是用户不愿意看到的。所以应在执行这些代码之前显示一个对话框来询问用户是否保存文档还是取消操作。这个对话框用VBA的MsgBox函数就可以做到，但是如果你是WINDOWS XP的用户你就会发现VB的MsgBox函数显示的对话框的风格和Excel本身所显示的对话框的风格很不一样（前提是你选择的不是Windows的经典外观）。这就显得不协调，见下图：

Excel对话框

VBA的MsgBox函数对话框

为了协调起见，我们就用Excel5的宏对话框来创建一个对话框，使其的风格样式和Excel对话框几乎没有分别，而且可以自定义对话框的标题及显示的消息。效果见下图：

Excel对话框

自定制的宏对话框

在这里我就介绍一下定制的过程。

在你需要建立对话框的文档里插入一个 Ms Excel 5.0 对话框。方法是点击任意工作表标签，然后选择弹出菜单中的 插入 菜单，在 插入 对话框中选择 Ms Excel 5.0 对话框。单击 确定 按钮。然后将其命名为“关闭前对话框”。

在对话框表中右键单击对话框的外框，选择 设置控件格式 菜单，将其控件格式设置为下图：

在窗体原有的两个按钮的基础上添加一个按钮，然后将按钮的标题分别更改为 是(Y) 、 否(N) 和  取消。

右键分别单击这三个按钮，选择 设置控件格式 菜单，将三个控件的大小格式设置如下图：

分别设置 是(Y) 、否(N) 和 取消 控件的其它格式如图：

是(Y) 按钮

否(N) 按钮

取消 按钮

在窗体上新建一个标签控件，将其更名为　Prompt　，将其格式设置如图：

最后对照上面的Excel对话框截图，对各个控件的位置进行调整使其以Excel对话框的控件位置一致。

分别指定 对话框外框、按纽 是(N) 、 否(N) 和 取消 的宏为　ShowDialog　、　COk　、　CNo　和　CCancel。

在VBE的 立即窗口 中输入以下代码，按 回车 键，隐藏宏对话框表。（如值为-1则可使对话框表可见）

ThisWorkbook.DialogSheets("关闭前对话框").visible=2

完成以上工作后，在VBE的模块和工作薄过程中添加以下代码，之后只要你对文档做出更改，在关闭文档时就会弹出此对话框询问你是否保存更改。

代码：

'//******************************************************************************************************************************************

'//此模块的过程主要是EXCEL5.0宏对话框的调用，主要用于在关闭文当前询问用户是否保存对文档所做的修改，采用宏对话框主要是为了保持此类对话框的风格一致。*

'//******************************************************************************************************************************************

'//从指定的模块或应用程序实例中载入一个图标

Private Declare Function LoadIcon _

    Lib "user32" _

    Alias "LoadIconA" ( _

        ByVal hInstance As Long, _

        ByVal lpIconName As Any) _

As Long

'//清除图标

Private Declare Function DestroyIcon _

    Lib "user32" ( _

        ByVal hIcon As Long) _

As Long

'//获得窗口在屏幕坐标中的位置

Private Declare Function GetWindowRect _

    Lib "user32" ( _

    ByVal hwnd As Long, _

    lpRect As RECT) _

As Long

'//移动窗体的API

Private Declare Function Movewindow _

    Lib "user32" _

    Alias "MoveWindow" ( _

        ByVal hwnd As Long, _

        ByVal x As Long, _

        ByVal y As Long, _

        ByVal nWidth As Long, _

        ByVal nHeight As Long, _

        ByVal bRepaint As Long) _

As Long

'//用来产生TIMER控件的效果。

Private Declare Function SetTimer _

    Lib "user32" ( _

        ByVal hwnd As Long, _

        ByVal nIDEvent As Long, _

        ByVal uElapse As Long, _

        ByVal lpTimerfunc As Long) _

As Long

'//结束Settimer过程

Public Declare Function KillTimer _

    Lib "user32" ( _

        ByVal hwnd As Long, _

        ByVal nIDEvent As Long) _

As Long

'//查找窗体句柄

Private Declare Function FindWindow _

    Lib "user32" _

    Alias "FindWindowA" ( _

        ByVal lpClassName As String, _

        ByVal lpWindowName As String) _

As Long

'//释放设备环境

Private Declare Function ReleaseDC _

    Lib "user32" ( _

        ByVal hwnd As Long, _

        ByVal hdc As Long) _

As Long

'//取得窗体设备环境

Private Declare Function GetDC _

    Lib "user32" ( _

ByVal hwnd As Long)

As Long

'//取得系统颜色刷

Private Declare Function GetSysColorBrush _

    Lib "user32" ( _

    ByVal nIndex As Long) _

As Long

'//绘制图标

Private Declare Function DrawIconEx _

    Lib "user32" ( _

        ByVal hdc As Long, _

        ByVal xLeft As Long, _

        ByVal yTop As Long, _

        ByVal hIcon As Long, _

        ByVal cxWidth As Long, _

        ByVal cyWidth As Long, _

        ByVal istepIfAniCur As Long, _

        ByVal hbrFlickerFreeDraw As Long, _

        ByVal diFlags As Long) _

As Long

'//准备用来取得屏幕的高和宽（像素为单位）

Private Declare Function GetSystemMetrics _

    Lib "user32" ( _

    ByVal nIndex As Long) _

As Long

'//设置窗体标题或控件内容

Private Declare Function SetWindowText _

    Lib "user32" _

    Alias "SetWindowTextA" ( _

        ByVal hwnd As Long, _

        ByVal lpString As String) _

As Long

'//——以下定义常数及类型——

Private Type RECT

        Left As Long

        Top As Long

        Right As Long

        Bottom As Long

End Type

Private Const SM_CXSCREEN = 0

Private Const SM_CYSCREEN = 1

Private Const IDI_EXCLAMATION = 32515&                            '惊叹图标

Public Const MyYes As String = "YES"

Public Const MyNo As String = "NO"

Public Const MyCancel As String = "CANCEL"

Private Const COLOR_BTNFACE = 15                                  '按钮表面色

Private Const DI_NORMAL = &H3                                     '用常规方式绘图（合并 DI_IMAGE 和 DI_MASK）

'//——以下定义变量——

Public DialogHwnd As Long                                         '对话框句柄

Public MyTid As Long

Public BackSaveMsg As String                                      '对话框返回值

Private DialogTitle As String, DialogPrompt As String

'//****************************************************************************************************************************************

'//以下三个过程取得用户点击窗体时的返回值

'//****************************************************************************************************************************************

Public Sub COk()

    BackSaveMsg = MyYes                                           '点击“是”

End Sub

'//--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Public Sub CNo()

    BackSaveMsg = MyNo                                            '点击“否”

End Sub

'//--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Public Sub CCancel()

    BackSaveMsg = MyCancel                                        '点击“取消”

End Sub

'//--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

'//****************************************************************************************************************************************

'//显示窗体在指定的位置，和设定窗体标题等

'//****************************************************************************************************************************************

Sub ShowDialog()

    Dim DialogRect As RECT, VidWidth As Long, VidHeight As Long, Mleft As Long, Mtop As Long

    '//设置对话框显示信息

    ThisWorkbook.DialogSheets("关闭前对话框").Labels("Prompt").Caption = DialogPrompt

    VidWidth = GetSystemMetrics(SM_CXSCREEN)                    '取得屏幕的宽

    VidHeight = GetSystemMetrics(SM_CYSCREEN)                   '取得屏幕的高

    DialogHwnd = FindWindow("bosa_sdm_XL9", vbNullString)         '取得EXCEL5宏对话框的句柄

    SetWindowText DialogHwnd, DialogTitle                         '设置窗体标题

    GetWindowRect DialogHwnd, DialogRect                          '取得宏对话框的窗体区域

    Mleft = (VidWidth - (DialogRect.Right - DialogRect.Left)) / 2 '取得显示时的左上角横坐标（X）

    Mtop = (VidHeight - (DialogRect.Bottom - DialogRect.Top)) / 2 '取得显示时的左上角纵坐标（Y）

    '//移动窗体至指定位置

    Movewindow DialogHwnd, Mleft, Mtop, DialogRect.Right - DialogRect.Left, DialogRect.Bottom - DialogRect.Top, True

    '//设置SetTimer过程

    MyTid = SetTimer(DialogHwnd, 0, 10, AddressOf pMsgOutProc)

End Sub

'//****************************************************************************************************************************************

'//以下代码创建了一个函数，其返回值其参数为：

'//返回值： String型，共有3个：1、MyYes；2、MyNo；3、MyCancel分别代表，点击“是”按钮、点击“否”按钮和点击“取消”按钮

'//Prompt： 可选的。字符串表达式，作为显示在对话框中的消息。如果省略 Prompt，则将显示"您是否保存对此份示例文档的修改?"字符串。

'//Title：  可选的。在对话框标题栏中显示的字符串表达式。如果省略 Title，则将显示"OFFICE精英俱乐部"字符串。

'//****************************************************************************************************************************************

Public Function CloseDialog(Optional Prompt As String = "您是否保存对此份示例文档的修改?", Optional Title As String = "OFFICE精英俱乐部") As String

    DialogTitle = Title

    DialogPrompt = Prompt

    Application.ExecuteExcel4Macro ("Beep(3)")                     '发出声音

    ThisWorkbook.DialogSheets("关闭前对话框").Show                  '显示EXCEL宏对话框

    CloseDialog = BackSaveMsg                                      '取得返回值

End Function

'//****************************************************************************************************************************************

'//回调函数

'//****************************************************************************************************************************************

Private Function pMsgOutProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal SysTime As Long) As Long

    Dim MYdc As Long, myIcon As Long

    Dim IconRush As Long

    IconRush = GetSysColorBrush(COLOR_BTNFACE)                                  '取得按钮颜色刷

    MYdc = GetDC(DialogHwnd)                                                    '取得宏对话框场景

    myIcon = LoadIcon(0, IDI_EXCLAMATION)                                       '载入图标

    DrawIconEx MYdc, 17, 10, myIcon, 0, 0, 0, IconRush, DI_NORMAL               '在指定位置绘制图标，在这里最好用DrawIconEx函数。而不用DrawIcon函数，不然绘制图标时闪烁的厉害

    DestroyIcon myIcon                                                          '清除图标

    ReleaseDC DialogHwnd, MYdc                                                  '释放窗体设备场景

End Function

'//****************************************************************************************************************************************

'//此为表格一按钮调用代码

'//****************************************************************************************************************************************

Sub Example()

    ThisWorkbook.Worksheets(1).Range("A1").Value = "更改"

    Application.Quit

End Sub

'//-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

说明: 本范例是定制了一个Excel 5 的对话框，使其可以替代原Excel关闭文档前的询问用户是否保存文档的对话框。并可以自定义对话框显示的标题及显示的消息。文档中所用API函数的具体说明见相关资料。

联系我：QQ：758237 MSN：168168@LIVE.CN

作者博客地址：http://www.excelfans.blog.sohu.com/