[求助]设置自选图形的默认效果及画布增删

守柔

TO 雨雪霏霏兄：

早上用了近二个小时，对你所提的问题，进一步的改进，目前尚在调试阶段，可能会在今晚或明晨才能把结果放在来，请等待。

我的无奈：

直接在自定义的按钮上双击，已基本否定这个可行性，先时我认为通过直接的设置ID属性即可，但这个ID不能随意设置，限制性非常大，估计目前无法解决，建议还是多点击一下鼠标吧，变通一下。

关于文档窗口的问题，看你的截图，不象是WORD2003？

关于画布，目前我的研究没有进展。WORD到2003版止，尚不支持对于画布功能的开发，你一定也录个宏，能看得出，WORD没有或者说不记录画布操作。虽然VBA中可以直接访问画布中的对象（图形），但对于返回画布中的选定图形，却卡住了，所选图形是关键，常规方法，将返回画布非画布中的所选图形。我已考虑使用替代方法，但有BUG，也就是如果用户绘制后删除了该图形，可能会有错误产生。（设计思路阶段，尚未写代码）。

扩充的问题，缘于你对代码不理解，等我把代码贴上来，你自然就明白了。

关于井水不犯河水，已初步完成代码，但基于WORD 自身的限制（对于绘图工具栏，没有一一等效的Word命令），在每次使用原有默认效果之前，必须“手动”运行一个宏（相当于触发事件），使其从SHAPESTEMPLATE中“引用”上次储存的默认格式。

综上所述，本次代码过程，最好的打算是能满足楼主所有基于非画布中的图形格式设置；有可能满足画布中的图形格式设置。但所有代码，并非能满足所有自选图形（种类大多，我不能一一例举），所以，如果有扩充，你应该学会。究竟有多少，可在VBA帮助中，查找AUTOSHAPETYPE属性中的MSOAUTOSHAPETYPE常量值。

 对话框功能，我目前尚未着手处理，但应该不会是技术瓶颈。

雨雪霏霏

　　老大自从8月8日清晨接手小弟的求助以来，到现在不足一个礼拜，却已经为小弟耗费了难以想象的超量的时间精力！小弟刚才将整个求助帖从头到尾浏览了一遍，老大所付出的，真的令小弟久久难以平静！——并不具备“普遍性”的、只属于小弟个人的“特殊需要”的问题，老大用恒久而火热的“兄弟之心”来帮助小弟，公司、家庭、论坛都十分需要老大，奈何为小弟这样一个“不起眼而又烦琐的问题”耗去了恁多“生命”！小弟除了感激，除了像上次得孔兄帮助设计“日记模板”时鼓荡于心的“恨不是女儿身”以永生相随之“冲动”，还能说些什么？做些什么？看来，小弟大概是难以逃脱“家”的魔掌了——生是“家”中人，死是“家”中鬼！

　　“言有穷而情不可终”，小弟对此只能吁嗟停笔了！

　　

　　以下是由老大在上楼的回复引发的一些片段之想：

　　1、双击效果问题。

　　老大说出了这样的思路，让小弟顿时思绪纷飞——真要解决这个问题，大概唯一的办法是从ID入手了。这可是一片“广阔的天空”！小弟羡慕老大已经在Word的海底自在游弋了！

　　小弟对这个问题不敢再“要求”了，事实上，有了老大提供的“变通”之策，“新栏”上的按钮具不具备“双击效果”，对小弟的操作影响不是太大。请老大不要再考虑这个问题。

　　2、文档窗口问题。

　　这是小弟在使用了“XP变脸王”之后的界面，它仍然是“Windows XP＋Word2003”。估计同时出现两个窗口的问题与“XP变脸王”无关，大概是小弟的Word程序本身有点问题（里头有太多自己弄的杂牌“宏”）。

　　3、画布问题。

　　老大为这个问题花了极大的心思。确实，如老大所说，Word目前对“画布”操作还不见有专项的VBA编码，要老大在这个问题上达到小弟的要求（小弟的整个作图过程，万不可缺的便是“画布”），实在是要老大“超越”微软呢！

　　因此，对于老大楼上最后说的“最好的打算是能满足楼主所有基于非画布中的图形格式设置；有可能满足画布中的图形格式设置”，小弟“老泪纵横”——小里说是为小弟难以得到“镆铘剑”而惋惜，大里说是为老大此番上霄汉下龙宫帮小弟苦觅此剑之深谊而感极慨极！

　　深谢老大在付出“直取”的种种努力无果之后，仍然作着种种“巧取”的努力，帮小弟最大限度解决了重复劳动问题！

　　4、扩充问题。

　　感谢老大的细心呵护——这是在托着小弟的两腋，教小弟怎么学走路呢！不肖如小弟，而能得如此亲昵“慈爱”之老大，真真是“奇遇”！期待老大的谆谆诲导！

　　5、井水河水问题。

　　呵呵，看得出老大前两天都一直在为小弟忙活呢！谢谢老大！

　　小弟发现整个编程里头有这么一个“巧妙”之处——既然是“井水不犯河水”，那么，“新栏”的“双击效果”要籍由“绘图工具栏”来实现，便只能是在未点下“还原”按钮之前，井水与河水混为一体；而一点下“还原”按钮，则老大的“新栏”之河水便退开去，只留下“绘图工具栏”之井水留待自由饮用（亦即像根本不存在过“新栏”一样，Word的所有绘图功能都可照常使用）。

　　6、对话框问题。

　　谢谢老大于此提出。小弟这里且提供一个信息让老大参考：“设置对象格式”对话框有“记忆”功能，即你上次最后使用过什么选项卡，下次打开这个对话框，出现的必定还是这个选项卡的界面。它“太活”了，所以，要在几个按钮里分别“钉死”各个选项卡界面，也有难度。

　　7、VBA问题。

　　小弟虽然有着孔兄、老大、Word版块得天独厚的资源，手头也尽管有一些VBA书籍，都还没有“看出个究竟”，仍然是刘姥姥来到“家”里这个大观园，会被壁里的西洋自鸣钟吓傻，躺在龙床上而不自知。大概，还得等小弟做完地里的活之后，等冬闲之时，背着小学识字课本，上“孔府”“柔府”上去好好拜谒两位“先知”“挚友”，得一一点拨，方才有些个明白“天地之大”“井外之奇”！

　　谨碎语如上，冀老大一哂！

守柔

慢慢完善起来，调试与测试并重，请进一步测试。（撇开画布，如无有异常，则转入下一步工作，实际上如果成功，只是加入几句代码）

这是新增的部分代码，另外的，请详看附件。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2006-8-14 6:21:44
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0055^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub SetDrawingDefaults()
'修改Word命令,此代码用于右键中的设置自选图形默认效果
'该代码基于将当前所选图形格式应于Mydoc中并储存起来.然后将myDoc中的指定图形格式
'应用于本文档中,再设置为默认格式
    On Error Resume Next
    Dim myShape As Shape, shType As MsoShapeType
    Dim AutoType As MsoAutoShapeType
    myDoc.Shapes("mySetShapeDefault").Delete
    With Selection.ShapeRange(1)
        shType = .Type
        .SetShapesDefaultProperties
        .PickUp
        Select Case shType
        Case msoAutoShape
            AutoType = .AutoShapeType
            Select Case AutoType
            Case msoShapeFlowchartAlternateProcess
                Set myShape = myDoc.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 0, 0, 0, 0)
            Case msoShapeFlowchartProcess
                Set myShape = myDoc.Shapes.AddShape(msoShapeFlowchartProcess, 0, 0, 0, 0)
            Case msoShapeMixed
                Set myShape = myDoc.Shapes.AddShape(msoShapeRectangle, 0, 0, 0, 0)
            Case msoShapeOval
                Set myShape = myDoc.Shapes.AddShape(msoShapeOval, 0, 0, 0, 0)
            Case Else
                Set myShape = myDoc.Shapes.AddShape(msoShapeRectangle, 0, 0, 0, 0)
            End Select
        Case msoLine
            Set myShape = myDoc.Shapes.AddLine(0, 0, 0, 0)
        Case msoTextBox
            Set myShape = myDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
        End Select
        myShape.Name = "mySetShapeDefault"
        myShape.Apply
    End With
End Sub
'----------------------
Sub ShowDialogbywdDialogFormatDrawingObject()
    Dim myDialog As Dialog, N As String
    N = Word.CommandBars.ActionControl.Caption
    Set myDialog = Word.Dialogs(wdDialogFormatDrawingObject)
    With myDialog
        Select Case N
        Case "线条与颜色"
            .DefaultTab = 1200000
        Case "大小"
            .DefaultTab = 1200001
        Case "版式"
            .DefaultTab = 1200002
        Case "文本框"
            .DefaultTab = 1200005
        End Select
        .Show
    End With
End Sub

j6SJpbpz.rar (34.2 KB, 下载次数: 28)

2006-8-14 06:24 上传

点击文件名下载附件

[此贴子已经被作者于2006-8-14 6:24:43编辑过]

守柔

说明：

在“图形格式设置”工具栏中，新增了“我的设置”三个下拉命令，它们的功能简述如下：

单击“错误重启”命令，将执行以下过程：

Sub StartRunAndRestart()
'检测并调用指定图形模板
'该过程可用于发生错误终止后的"重启"
    On Error Resume Next
    Dim TempFullName As String
    TempFullName = Me.Path & "\ShapesTemplate.doc"
    If Dir(TempFullName, vbDirectory) = "" Then
        MsgBox "Word未找到指定图形模板，程序无法继续！", vbExclamation
        Exit Sub
    End If
    Set myDoc = Documents.Open(FileName:=TempFullName, Visible:=False)
    Call FormatSetUp(19)    '调用上次设置的自选图形默认效果(通过右键/设置自选图形默认效果)
End Sub

此过程针对由于意外程序的中断、终止或者错误时，产生的对象变量未设置的情况（有两种可能，一是myDoc从内存中消逝，另外是由于myDoc.Shapes("mySetShapeDefault")对象找不到，该对象是在右键设置默认自选图形效果时产生的，先删除后增加这个"mySetShapeDefault"名称的图形，如果用户选择了某个非程序中指定图形类型时，将可能发生此现象。

由于是调试测试阶段，我并未真正进行错误处理。这也是昨天我提到的自选图形和其他图形种类繁多不能一一例举可能产生的问题。

如果发生错误现象，单击此命令可能有效，如果没有建立Shapes("mySetShapeDefault")对象，则将发生错误。请注意。（处理起来也很简单，在模板中运行一下一个SHOWME的宏，撤消一下操作即可---删除操作）

“恢复原始设置”，是指还原为空白文档中的自选图形默认效果。

“我的默认设置”，关键操作。总是应用上次用户单击右键时的设置自选图形默认效果。在上面的设计思路中，我提到了，本程序中的重点就是这个命令，那么由于是多次反复设置，因此，要想记忆用户的“手动”设置过程，只有把默认效果保存于“模板”中才有效。每次在使用“图形格式设置”工具栏中的其他绘图命令后，若需要应用用户的“手动”设置，必须单击该命令，然后使用“绘图”工具栏中的任意命令，绘制出用户定义的图形格式来。

对话框下拉命令，不说明了，一目了然。

雨雪霏霏

谢谢老大！跋山涉水，风餐露宿，“黄龙”在望矣！一路上多辛苦了老大！

这次测试未涉及“画布”，除了“错误重启”一项小弟尚不懂得怎样测试之外，其余各项的测试结果报告如下：

①在台式电脑上测试，“OK三版”运行完全正常！新增的“红圆”、“我的设置”和“文本框”三个下拉菜单各按钮，使用效果完全实现了预先之想。

②笔记本电脑上，问题如下（注：此问题请老大不必费心去想，因为这肯定是小弟笔记本电脑的问题，在这儿说出来，只是告诉老大我的所有操作情况）：

A、仍然如前边的贴图，“ShapesTemplate.doc”会同时出现，而且是显示在屏幕的最前面。

B、“红圆”按钮无法使用。即点击“红圆”时，都会出现下面的对话框：

 

 

谢谢老大的汗水！“OK三版”给小弟带来前所未有的方便！测试圆满成功！

小弟“第二阶段”的问题简述如下：

1、画布自由增删的问题。

2、如何实现在任意一个Word文档中使用“OK三版”的问题。——惭愧，小弟上午尝试了一阵，找不到正确的方法，只得求教于老大了！

接下来的一个礼拜，小弟有事外出，大概不能及时上网回应老大的劳动，请老大见谅！现在，小弟便要出发了，匆此“简报”，对不住老大！谢意容后再表！

守柔

祝雨兄早日回家！

以下文档请解压于C:\Documents and Settings\UserNameApplication Data\Microsoft\Word\STARTUP文件夹中，将自动成为加载项，也可作为普通模板（非此STARTUP文件夹中，使用工具/模板和加载项加载之）

 请再行测试（我试过几次了，有些问题在代码中我有交待，Word对于画布，还是不支持，一时找不到更好的方法）

Ym7SlKH2.rar (23.88 KB, 下载次数: 22)

2006-8-17 06:11 上传

点击文件名下载附件
[求助]设置自选图形的默认效果及画布增删

以下是该模板（加载项）全部代码，供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2006-8-17 6:14:15
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0056^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Dim F As Byte, myMsg As String
Const msgTitle As String = "ExcelHome_Word"

'Sub AutoExit()
'    Me.Save
'End Sub
Sub AutoExec()
    FormatSetUp (19)
End Sub
'----------------------
Sub FormatSetUp(F As Byte)
'设置自选图形默认格式以及直接进入绘图状态
    Dim myShape As Shape, shType As MsoShapeType
    Dim AutoType As MsoAutoShapeType
    Dim standardShape As Shape
    On Error GoTo ErrHandle
    If F = 19 Then
        Set standardShape = Me.Shapes("mySetShapeDefault")
    Else
        Set standardShape = Me.Shapes(F)
    End If
    standardShape.PickUp
    shType = standardShape.Type
    Select Case shType
    Case msoAutoShape
        AutoType = standardShape.AutoShapeType
        Select Case AutoType
        Case msoShapeFlowchartAlternateProcess
            Set myShape = ActiveDocument.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 0, 0, 0, 0)
            myShape.Apply
            myShape.SetShapesDefaultProperties
            myShape.Delete
            If F <> 19 Then Word.CommandBars("Drawing").Controls(3).Controls(5).Controls(2).Execute
        Case msoShapeFlowchartProcess
            Set myShape = ActiveDocument.Shapes.AddShape(msoShapeFlowchartProcess, 0, 0, 0, 0)

守柔

            myShape.Apply
            myShape.SetShapesDefaultProperties
            myShape.Delete
            If F <> 19 Then Word.CommandBars("Drawing").Controls(3).Controls(5).Controls(1).Execute
        Case msoShapeOval
            Set myShape = ActiveDocument.Shapes.AddShape(msoShapeOval, 0, 0, 0, 0)
            myShape.Apply
            myShape.SetShapesDefaultProperties
            myShape.Delete
            If F <> 19 Then Word.CommandBars("Drawing").Controls(7).Execute
        Case msoShapeMixed
            Select Case F
            Case 11 To 14
                Set myShape = ActiveDocument.Shapes.AddConnector(msoConnectorCurve, 0, 0, 0, 0)
                myShape.Apply
                myShape.SetShapesDefaultProperties
                myShape.Delete
                If F <> 19 Then Word.CommandBars("Drawing").Controls(3).Controls(2).Controls(7).Execute
            Case 15, 16
                Set myShape = ActiveDocument.Shapes.AddConnector(msoConnectorElbow, 0, 0, 0, 0)
                myShape.Apply
                myShape.SetShapesDefaultProperties
                myShape.Delete
                If F <> 19 Then Word.CommandBars("Drawing").Controls(3).Controls(2).Controls(4).Execute
            End Select
        Case Else
            Set myShape = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 0, 0, 0, 0)
            myShape.Apply
            myShape.SetShapesDefaultProperties
            myShape.Delete
        End Select
    Case msoLine
        Set myShape = ActiveDocument.Shapes.AddLine(0, 0, 0, 0)
    Case msoTextBox
        Set myShape = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
    End Select
       Me.Saved = True
    Exit Sub
ErrHandle:
    myMsg = "出错的过程名为:FormatSetUp" & vbCrLf
    myMsg = myMsg & Now & "程序运行中发现错误:" & vbCrLf & "错误号:" & Err.Number & ",出错原因为:" & Err.Description
    Err.Clear
    Call HandleError
End Sub

守柔

'----------------------
Sub S1()
    F = 1
    Call FormatSetUp(1)
End Sub
'----------------------
Sub S2()
    F = 2
    Call FormatSetUp(2)
End Sub
'----------------------
Sub S3()
    F = 3
    Call FormatSetUp(3)
End Sub
'----------------------
Sub S4()
    F = 4
    Call FormatSetUp(4)
End Sub
'----------------------
Sub S5()
    F = 5
    Call FormatSetUp(5)
End Sub
'----------------------
Sub S6()
    F = 6
    Call FormatSetUp(6)
End Sub
'----------------------
Sub S7()
    F = 7
    Call FormatSetUp(7)
End Sub
'----------------------
Sub S8()
    F = 8
    Call FormatSetUp(8)
End Sub
'----------------------
Sub S9()
    F = 9
    Call FormatSetUp(9)
End Sub
'----------------------
Sub S10()
    F = 10
    Call FormatSetUp(10)
End Sub
'----------------------
Sub S11()
    F = 11
    Call FormatSetUp(11)
End Sub
'----------------------
Sub S12()
    F = 12
    Call FormatSetUp(12)
End Sub
'----------------------
Sub S13()
    F = 13
    Call FormatSetUp(13)
End Sub
'----------------------
Sub S14()
    F = 14
    Call FormatSetUp(14)
End Sub
'----------------------
Sub S15()
    F = 15
    Call FormatSetUp(15)
End Sub
'----------------------
Sub S16()
    F = 16
    Call FormatSetUp(16)
End Sub
'----------------------
Sub S17()    '红圆
    Call FormatSetUp(17)
End Sub
'----------------------
Sub S18()    '恢复Word初始默认自选图形格式
    Call FormatSetUp(18)
End Sub
'----------------------
Sub S19()    '调用"模板中的"储存的格式设置
    Call FormatSetUp(19)
End Sub
'----------------------

守柔

Sub mySet(W As Byte)
'设置图形高度\文本框上下左右间距或者连接符箭头样式等
    Dim mySp As Shape
    On Error GoTo ErrHandle
    '由于Word中不支持对于画布中选定图形的直接返回,此处的代码实际上有BUG
    With Selection
        If .Type = wdSelectionShape Then    '如果所选的是图形的话
            If .ShapeRange(1).Type = msoCanvas Then    '如果所选图形是画布(画布中的某个图形)
                Set mySp = .ShapeRange(1).CanvasItems(.ShapeRange(1).CanvasItems.Count)    '定义为最后一个图形(总是新近创建/绘制的)
            Else
                Set mySp = .ShapeRange(1)    '否则为所选图形(非画布状态)
            End If
        Else
            Exit Sub
        End If
    End With
    With mySp
        Select Case W
        Case 1 To 10
            Select Case W
            Case 1
                .Height = Word.CentimetersToPoints(0.65)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.05)
                    .MarginRight = Word.CentimetersToPoints(0.05)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With
            Case 2
                .Height = Word.CentimetersToPoints(0.65)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With
            Case 3
                .Height = Word.CentimetersToPoints(1.26)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.05)
                    .MarginRight = Word.CentimetersToPoints(0.05)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With
            Case 4
                .Height = Word.CentimetersToPoints(1.26)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With

守柔

            Case 5
                .Height = Word.CentimetersToPoints(0.65)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.05)
                    .MarginRight = Word.CentimetersToPoints(0.05)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With
            Case 6
                .Height = Word.CentimetersToPoints(0.65)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.03)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.03)
                End With
            Case 7
                .Height = Word.CentimetersToPoints(0.7)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.07)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.07)
                End With
            Case 8
                .Height = Word.CentimetersToPoints(1.3)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.07)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.07)
                End With
            Case 9
                .Height = Word.CentimetersToPoints(0.75)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.07)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.07)
                End With
            Case 10
                .Height = Word.CentimetersToPoints(1.35)
                With .TextFrame
                    .MarginBottom = Word.CentimetersToPoints(0.07)
                    .MarginLeft = Word.CentimetersToPoints(0.15)
                    .MarginRight = Word.CentimetersToPoints(0.15)
                    .MarginTop = Word.CentimetersToPoints(0.07)
                End With
            End Select
            .TextFrame.TextRange.Select
            Selection.Collapse
        Case 11 To 16
            Select Case W
            Case 11
            Case 12, 14, 15
                .Line.BeginArrowheadLength = msoArrowheadLengthMedium
                .Line.BeginArrowheadWidth = msoArrowheadWidthMedium
                .Line.BeginArrowheadStyle = msoArrowheadOval
            Case 16
                .Line.BeginArrowheadLength = msoArrowheadShort
                .Line.BeginArrowheadWidth = msoArrowheadNarrow
                .Line.BeginArrowheadStyle = msoArrowheadDiamond
                .Line.EndArrowheadLength = msoArrowheadShort
                .Line.EndArrowheadWidth = msoArrowheadNarrow
                .Line.EndArrowheadStyle = msoArrowheadDiamond
            End Select
        End Select
    End With
    Exit Sub
ErrHandle:
    myMsg = "出错的过程名为:mySet" & vbCrLf
    myMsg = myMsg & Now & "程序运行中发现错误:" & vbCrLf & "错误号:" & Err.Number & ",出错原因为:" & Err.Description
    Err.Clear
    Call HandleError
End Sub
'----------------------