仿Excel 关闭前保存文档对话框.docx

1、仿Excel 关闭前保存文档对话框仿Excel 关闭前保存文档对话框（一）主题:仿Excel 关闭前保存文档对话框版 本:Excel2000及其以后版本说 明: 本示例主要仿建了一个Excel 关闭前保存文档对话框，让用户可以自定义标题和显示消息。（Code By wangminbai）在Excel中当用户更改了一个文档之后在关闭文档时就会显示一个询问用户是否保存文档的对话框，但此对话框的标题和显示消息总是一成不变的，久了就会觉得没有味道。而且当用户在工作薄的Workbook_BeforeClose过程中设置了代码时，即使用户了点击询问对话框的“取消”按钮来取消关闭文档的操作时，你也会发现Wo

2、rkbook_BeforeClose过程的中的代码已经被执行，用户的很多设置已经被更改。而这往往是用户不愿意看到的。所以应在执行这些代码之前显示一个对话框来询问用户是否保存文档还是取消操作。这个对话框用VBA的MsgBox函数就可以做到，但是如果你是WINDOWS XP的用户你就会发现VB的MsgBox函数显示的对话框的风格和Excel本身所显示的对话框的风格很不一样（前提是你选择的不是Windows的经典外观）。这就显得不协调，见下图：Excel对话框VBA的MsgBox函数对话框为了协调起见，我们就用Excel5的宏对话框来创建一个对话框，使其的风格样式和Excel对话框几乎没有分别，而且

3、可以自定义对话框的标题及显示的消息。效果见下图：Excel对话框自定制的宏对话框在这里我就介绍一下定制的过程。在你需要建立对话框的文档里插入一个 Ms Excel 5.0 对话框。方法是点击任意工作表标签，然后选择弹出菜单中的 插入 菜单，在 插入 对话框中选择 Ms Excel 5.0 对话框。单击 确定 按钮。然后将其命名为“关闭前对话框”。在对话框表中右键单击对话框的外框，选择 设置控件格式 菜单，将其控件格式设置为下图：在窗体原有的两个按钮的基础上添加一个按钮，然后将按钮的标题分别更改为 是(Y) 、 否(N) 和 取消。右键分别单击这三个按钮，选择 设置控件格式 菜单，将三个控件的大

4、小格式设置如下图：分别设置 是(Y) 、否(N) 和 取消 控件的其它格式如图：是(Y) 按钮否(N) 按钮取消 按钮在窗体上新建一个标签控件，将其更名为Prompt，将其格式设置如图：最后对照上面的Excel对话框截图，对各个控件的位置进行调整使其以Excel对话框的控件位置一致。分别指定 对话框外框、按纽 是(N) 、 否(N) 和 取消 的宏为ShowDialog、COk、CNo和CCancel。在VBE的 立即窗口 中输入以下代码，按 回车 键，隐藏宏对话框表。（如值为-1则可使对话框表可见）ThisWorkbook.DialogSheets(关闭前对话框).visible=2完成以上

5、工作后，在VBE的模块和工作薄过程中添加以下代码，之后只要你对文档做出更改，在关闭文档时就会弹出此对话框询问你是否保存更改。代码：/*/此模块的过程主要是EXCEL5.0宏对话框的调用，主要用于在关闭文当前询问用户是否保存对文档所做的修改，采用宏对话框主要是为了保持此类对话框的风格一致。*/*/从指定的模块或应用程序实例中载入一个图标Private Declare Function LoadIcon _ Lib user32 _ Alias LoadIconA ( _ ByVal hInstance As Long, _ ByVal lpIconName As Any) _As Long/清除

6、图标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/移动窗体的APIPrivate Declare Function Movewindow _ Lib user32 _ Alias MoveWindow ( _ ByVal hwnd As Long

7、, _ 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/结

8、束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 Rel

9、easeDC _ 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 u

10、ser32 ( _ 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 GetSyste

11、mMetrics _ 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 LongEnd TypePrivate

12、Const SM_CXSCREEN = 0Private Const SM_CYSCREEN = 1Private Const IDI_EXCLAMATION = 32515& 惊叹图标Public Const MyYes As String = YESPublic Const MyNo As String = NOPublic Const MyCancel As String = CANCELPrivate Const COLOR_BTNFACE = 15 按钮表面色Private Const DI_NORMAL = &H3 用常规方式绘图（合并 DI_IMAGE 和 DI_MASK）/以下

13、定义变量Public DialogHwnd As Long 对话框句柄Public MyTid As LongPublic 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

14、 = 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 =

15、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 - (Dia

16、logRect.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

17、、MyYes；2、MyNo；3、MyCancel分别代表，点击“是”按钮、点击“否”按钮和点击“取消”按钮/Prompt： 可选的。字符串表达式，作为显示在对话框中的消息。如果省略 Prompt，则将显示您是否保存对此份示例文档的修改?字符串。/Title： 可选的。在对话框标题栏中显示的字符串表达式。如果省略 Title，则将显示OFFICE精英俱乐部字符串。/*Public Function CloseDialog(Optional Prompt As String = 您是否保存对此份示例文档的修改?, Optional Title As String = OFFICE精英俱乐部) As

18、 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 SysT

19、ime 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.QuitEnd Sub/-