[第5期] WORD工具栏/命令列表[已总结]

守柔

题目要求:

列表取得WORD所有工具栏及其一级控件的名称,ID,和FACEID图片.

说明:这是一个全面考虑WORD VBA的题目,由于相对比较复杂(其实大概在50行代码左右),因此,我们将分步给分:

要求如下,在一个空白文档中,设置页眉文本为"Word工具栏/命令列表",段落对齐居中,字体为16号加粗;页脚为"第 X 页 共 X 页",段落对齐为右对齐,其中X Y 分别为页码域和页数域;此为1分;

在正文中,要求在WORD的工具栏中循环,并取得所有工具栏的所有一级控件名称,ID号和FACEID图片.工具栏和控件命令均需列表计数,其中工具栏对应段落为加粗字体,无缩进;控件命令所在段落为左缩进1厘米,并分别设有三个制表位,它们的位置为2.5厘米,11厘米和14厘米,字体格式不加粗.凡正确得出控件名和ID\FACEID者得2分,制表位正确设置者再得1分;

优胜者最高为5分.

分步完成者按上述中分别给予.

结果见附件.

Option Explicit
Sub ControlsList()
Dim OldSet As WdWrapTypeMerged, EndRange As Range
Dim oCommandBar As CommandBar, oControl As CommandBarControl
Application.ScreenUpdating = False '关闭屏幕更新
OldSet = Word.Options.PictureWrapType '取得原有插入/粘贴图片时环绕方式
Word.Options.PictureWrapType = wdWrapMergeInline '设置为嵌入式
With ActiveDocument
With .Sections(1).Headers(wdHeaderFooterPrimary).Range '页眉中
.text = "Word工具栏/命令列表"
.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中
.Font.Size = 16 '16号字体
.Font.Bold = True '粗体
End With
With .Sections(1).Footers(wdHeaderFooterPrimary) '页脚中
NormalTemplate.AutoTextEntries("第 X 页 共 Y 页").Insert Where:=.Range '自动图文集
.Range.ParagraphFormat.Alignment = wdAlignParagraphRight '居右
End With
With .Content '设置三个制表位:2.5厘米,11厘米,14厘米
.Paragraphs.TabStops.Add Word.CentimetersToPoints(2.5)
.Paragraphs.TabStops.Add Word.CentimetersToPoints(11)
.Paragraphs.TabStops.Add Word.CentimetersToPoints(14)
For Each oCommandBar In Word.CommandBars '在命令栏中循环
.Paragraphs.Last.LeftIndent = 0 '无左缩进
.Paragraphs.Last.Range.Bold = True '最后一个段落为粗体
.InsertAfter oCommandBar.Index & ". " & oCommandBar.Name & Chr(13) '插入命令栏索引号和名称并增加一个段落
For Each oControl In oCommandBar.Controls
.Paragraphs.Last.Range.Bold = False '非加粗
.Paragraphs.Last.LeftIndent = Word.CentimetersToPoints(1) '左缩进1厘米
.InsertAfter oCommandBar.Index & "." & oControl.Index & vbTab & oControl.Caption & vbTab & "ID:=" & oControl.ID & vbTab & Chr(13)
If oControl.Type = msoControlButton Then '如果为msoControlButton则复制FACEID
oControl.CopyFace
Set EndRange = ActiveDocument.Range(.End - 2, .End - 2) '定义一个RANGE对象,始终是文档结束标记的前二个字符位置,即最后第二段落标记前一个字符位置
EndRange.Paste '粘贴
End If
Next
Next
End With
End With
Application.ScreenUpdating = True '恢复屏幕更新
Word.Options.PictureWrapType = OldSet '恢复用户原来的设置
End Sub
'----------------------

这次题目看似比较简单,当时的出发点就是:

1. 熟悉工具栏\控件对象,正确地应用其属性与方法;

2. 学习WORD中自动图文集的使用;

3. 学习WORD中制表位的设置,制表位具有继承性,如果我们在某一段设置了制表位,则其下一段落中,如果使用制表位,其位置将继承上一段落中的制表位位置.

4. 学习WORD中RANGE对象的使用;

5. 可以进行条件判断也可以进行错误处理时的错误捕捉代码的写法.

总结:

1. 绝大多数网友对于WORD还不是特别熟悉,所以,对于其选项中的一些设置可能有所忽略,那就是如果用户的工具/选项/编辑:图片插入/粘贴方式中,如果不是嵌入型,则图片的位置就会不符合要求了.

2. 对于RANGE对象的正确运用非常重要,它可以避免重复地使用SELECTION对象,从而加快程序运行和代码的紧凑性，合理性。

[此贴子已经被作者于2005-12-1 12:11:11编辑过]

jlhao

把所有生成的工具栏内容都贴上来文件太大,所以只留了一个工具栏的,剩下的执行代码后看结果吧

Sub ViewTools() Dim oWord, curCmdBar, curCtl, curCtlCount, curMnuCount ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.TypeText Text:="Word工具栏/命令列表" Selection.WholeStory Selection.Font.Size = 16 Selection.Font.Bold = True Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter If Selection.HeaderFooter.IsHeader = True Then ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter Else ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader End If NormalTemplate.AutoTextEntries("第 X 页 共 Y 页").Insert Where:=Selection. _ Range, RichText:=True Selection.ParagraphFormat.Alignment = wdAlignParagraphRight ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument Set oWord = Application Set curCmdBar = oWord.CommandBars("tools") Set curCtl = curCmdBar.Controls(20) curMnuCount = 1 Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(2.5) _ , Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(11) _ , Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(14 _ ), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces For Each mnus In oWord.CommandBars With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) .SpaceBeforeAuto = False .SpaceAfterAuto = False End With Selection.Font.Bold = True Selection.TypeText Text:=CStr(curMnuCount) + "." + mnus.Name Selection.Font.Bold = False Selection.TypeParagraph curCtlCount = 1 For Each ctls In mnus.Controls With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(1) .SpaceBeforeAuto = False .SpaceAfterAuto = False End With Selection.TypeText Text:=CStr(curMnuCount) + "." + CStr(curCtlCount) + Chr(9) + _ ctls.Caption + Chr(9) + "ID:=" + CStr(ctls.ID) + Chr(9) Set newCtl = CommandBars.FindControl(Type:=msoControlButton, ID:=ctls.ID) If Not (newCtl Is Nothing) Then newCtl.CopyFace Selection.PasteAndFormat (wdPasteDefault) End If Selection.TypeParagraph curCtlCount = curCtlCount + 1 Next ctls curMnuCount = curMnuCount + 1 Next mnus End Sub '************************************************************************************

1. 代码运行正常，满足要求。

2. 变量声明不够明确

3. 在大量文本图形使用SELECTION对象插入时没有关闭屏幕更新.

4. 没有考虑到如果WORD默认的图片插入方式是四周型(工具/选项/编辑/图片插入粘贴方式)时的结果会是怎么样的?

5. 代码中应用了大量了Selection对象与方法,使得程序看上去不是特别紧凑合理和高效.包括页眉页脚中的文本和页码的录入.

6. 判断FACEID是否存在,使用FindControl方法,个人意见不如判断Control的type属性来得更好一些,效率也更高一些.

7. Cstr函数是否必要?

[此贴子已经被守柔于2005-11-21 5:42:36编辑过]

hy8888

Sub listcontrols() Application.ScreenUpdating = False '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/第一步 ActiveWindow.View.Type = wdPrintView ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.TypeText Text:="WORD工具栏/命令列表" Selection.HomeKey Unit:=wdLine, Extend:=wdExtend Selection.Font.Bold = True Selection.Font.Size = 16 ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter Selection.TypeText Text:="第" Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage Selection.TypeText Text:="页 共" Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldNumPages Selection.TypeText Text:="页" Selection.ParagraphFormat.Alignment = wdAlignParagraphRight ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/第二步 ActiveWindow.View.Type = wdNormalView With Selection.ParagraphFormat.TabStops .Add Position:=CentimetersToPoints(2.5) .Add Position:=CentimetersToPoints(11) .Add Position:=CentimetersToPoints(14) End With pgs = 1 cbs = 1 On Error Resume Next For Each cb In Application.CommandBars With Selection .Font.Bold = True .TypeText Text:=cbs & "." & cb.Name .Paragraphs.Add End With pgs = pgs + 1 ThisDocument.Paragraphs(pgs).Range.Select With Selection .ParagraphFormat.LeftIndent = CentimetersToPoints(1) .Font.Bold = False End With ctrs = 1 For Each ct In cb.Controls With Selection .TypeText Text:=cbs & "." & ctrs & vbTab & ct.Caption & vbTab & "ID:=" & ct.ID & vbTab ct.CopyFace: If Err.Number = 0 Then .Paste Else Err.Clear .Paragraphs.Add pgs = pgs + 1 End With ThisDocument.Paragraphs(pgs).Range.Select ctrs = ctrs + 1 Next Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0) cbs = cbs + 1 Next ActiveWindow.View.Type = wdPrintView Application.ScreenUpdating = True End Sub

'*************************************************************************************

1. 代码运行正常，满足要求。

2. 缺少显式变量声明,对编程无益.

3. 在页脚中使用插入页码和页数域的方法不错,但在WORD中可以使用自动图文集的方法,更简单;当然,结合RANGE对象,你的第一步会更好.

4. 没有考虑到如果WORD默认的图片插入方式是四周型(工具/选项/编辑/图片插入粘贴方式)时的结果会是怎么样的?

5. 代码中应用了大量了Selection对象与方法,使得程序看上去不是特别紧凑合理和高效.如果使用RANGE对象,你会发现更好一些.

[此贴子已经被守柔于2005-11-21 5:52:20编辑过]

asdf1001

Sub begin() Application.ScreenUpdating = False first second Application.ScreenUpdating = True End Sub Sub first() With ThisDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range .Text = "WORD工具栏/命令列表" .Bold = True .Font.Size = 16 End With With ThisDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range .Text = "WORD工具栏/命令列表" .Bold = True .Font.Size = 16 End With With ThisDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range .Text = "第 页 共 页" .Fields.Add .Words(6), wdFieldNumPages .Fields.Add .Words(2), wdFieldPage .ParagraphFormat.Alignment = wdAlignParagraphRight End With With ThisDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range .Text = "第 页 共 页" .Fields.Add .Words(6), wdFieldNumPages .Fields.Add .Words(2), wdFieldPage .ParagraphFormat.Alignment = wdAlignParagraphRight End With End Sub Sub second() Dim ss As CommandBarControl Dim tt As CommandBar Dim tn As Long Dim n As Long Dim sn As Long n = 1 With ThisDocument.Paragraphs(n).Range.ParagraphFormat.TabStops .Add Position:=CentimetersToPoints(2.5) .Add Position:=CentimetersToPoints(11) .Add Position:=CentimetersToPoints(14) End With On Error Resume Next For Each tt In Application.CommandBars tn = tn + 1 With ThisDocument.Paragraphs(n).Range .Font.Bold = True .Text = tn & ". " & tt.Name .Paragraphs.Add End With n = n + 1 With ThisDocument.Paragraphs(n).Range .ParagraphFormat.LeftIndent = CentimetersToPoints(1) .Font.Bold = False End With sn = 0 For Each ss In tt.Controls sn = sn + 1 With ThisDocument.Paragraphs(n).Range .Text = tn & "." & sn & vbTab & ss.Caption & vbTab & "ID:=" & ss.ID & vbTab ss.CopyFace If Err.Number = 0 Then .Words.Last.Paste Else Err.Clear .Paragraphs.Add End With n = n + 1 Next ThisDocument.Paragraphs(n).Range.ParagraphFormat.LeftIndent = CentimetersToPoints(0) Next End Sub '*****************************************************************************

1. 代码运行正常，满足要求。

2. 思路清晰,RANGE对象应用充分,相当不错.

3. 在页脚中使用插入页码和页数域的方法不错,但在WORD中可以使用自动图文集的方法,更简单一些,通常如果是在WORD中插入嵌套域的话,是的正是这个方法,但直接使用RANGE而非WORDS对象.

4. 没有考虑到如果WORD默认的图片插入方式是四周型(工具/选项/编辑/图片插入粘贴方式)时的结果会是怎么样的?

5. ActiveDocument.Content.Paragraphs.Last可以用来表示文档的最后一个段落.

[此贴子已经被守柔于2005-11-21 5:59:09编辑过]

sallet

只能做出第一步．

代码也没有,可惜了,不过没关系,好好看总结,争取下一期得分.

[此贴子已经被守柔于2005-11-21 6:17:51编辑过]

prince

完成的界面如下（机器配置为赛扬D325，DDR256M，约60秒。）:

'***********************************************************

1. 代码运行正常，满足要求。

2. 变量声明和注释写得很认真

3. 没有考虑到如果WORD默认的图片插入方式是四周型(工具/选项/编辑/图片插入粘贴方式)时的结果会是怎么样的?

4. 部分使用了RANGE对象,如果进一步了解了RANGE对象,则遍历段落这些代码可以省略了.另外,如果是为了解决带有ID字样的段落为非粗体,可以将全文加粗后用FIND方法时,可以使用DO LOOP语句,即每次正确查找时粗体ID时设置其段落字体为非粗体,则采用FIND方法要比遍历段落更高效一些.

5. If mCommandControl.FaceId = Null这句判断用得很好.

[此贴子已经被守柔于2005-11-21 6:09:26编辑过]

sailorgg

学做了一个,版主看看:

Sub 页眉设置2() With Me.Sections(1).Headers(wdHeaderFooterPrimary).Range .Text = "Word工具栏/命令列表" .Font.Bold = True .Font.Size = 16 End With NormalTemplate.AutoTextEntries("第 X 页 共 Y 页").Insert Where:=ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range, RichText:=True ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.ParagraphFormat.Alignment = wdAlignParagraphRight End Sub

Sub myEXtest() '取得所有工具栏的名称、ID和按钮图标 Dim NUMbar As Byte, NUMcontonl As Byte Dim alltoolbar As CommandBar Dim allcontonl As CommandBarControl Selection.ParagraphFormat.TabStops.ClearAll ActiveDocument.DefaultTabStop = CentimetersToPoints(7) Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(10), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(2), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces Application.ScreenUpdating = False On Error Resume Next NUMbar = 1 For Each alltoolbar In Application.CommandBars Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0) Selection.Font.Bold = wdToggle Selection.TypeText Text:=NUMbar & " " & alltoolbar.Name & vbLf Selection.Font.Bold = wdToggle Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0.63) NUMcontonl = 1 For Each allcontonl In alltoolbar.Controls allcontonl.CopyFace If Err.Number = 438 Then Selection.TypeText Text:=NUMbar & "." & NUMcontonl & vbTab & allcontonl.Caption & vbTab & allcontonl.ID & vbTab & vbLf Err.Clear Else Selection.TypeText Text:=NUMbar & "." & NUMcontonl & vbTab & allcontonl.Caption & vbTab & allcontonl.ID & vbTab Selection.Paste Selection.TypeText Text:=vbLf End If NUMcontonl = NUMcontonl + 1 Next NUMbar = NUMbar + 1 Next Application.ScreenUpdating = True End Sub

'*****************************************************************

1. 代码运行正常，满足要求。

2. 整个程序非常精炼,变量声明到位(注意,一不小心可要溢出啊)

3. 没有考虑到如果WORD默认的图片插入方式是四周型(工具/选项/编辑/图片插入粘贴方式)时的结果会是怎么样的?

4. 页眉页脚部分使用了RANGE对象,其余部分采用了SELECTIN对象,可以进一步深化.

5. 错误处理在本题中,可以以其它方法进行判断更好一些.

[此贴子已经被守柔于2005-11-21 6:16:09编辑过]

shuyee

Private Sub Document_Open() Debug.Print Now() Dim i%, j%, tmpConF As CommandBarButton Documents.Add DocumentType:=wdNewBlankDocument '新开一空白文档 If ActiveWindow.View.SplitSpecial <> wdPaneNone Then '查窗格 ActiveWindow.Panes(2).Close End If Selection.Parent.View.Type = wdPrintView '设置为页面视图 Selection.Parent.View.ShowFieldCodes = False '不显示域代码,可以考虑保护现场问题. Selection.Parent.View.SeekView = wdSeekCurrentPageHeader '设置页眉 Selection.Font.Size = 16 '16号字体 Selection.Font.Bold = True '加粗 Selection.HeaderFooter.Range = "Word工具栏/命令列表" '赋值给页眉 Selection.MoveDown Unit:=wdLine, Count:=2 '移动到页脚 Selection.ParagraphFormat.Alignment = wdAlignParagraphRight '设置右对齐 NormalTemplate.AutoTextEntries("第 X 页 共 Y 页").Insert Where:=Selection.Range, RichText:=True '设置页脚 Selection.Parent.View.SeekView = wdSeekMainDocument '回到正文 ' Selection.ParagraphFormat.TabStops.ClearAll '删除所有制表符.由于是新文档,可以不考虑 Selection.PageSetup.LeftMargin = CentimetersToPoints(2.54) '改变页面左边界,以免影响显示效果 Selection.PageSetup.RightMargin = CentimetersToPoints(2.9) '改变右边界 Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(2.5) '设置制表符位置 Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(11) Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(14) For i = 1 To CommandBars.Count '对控件按钮集合进行循环 Dim tmps$ Selection.ParagraphFormat.LeftIndent = 0 '设置本段首行不缩进 Selection.Font.Bold = True '本段字体加粗 Selection.TypeText Text:=i & "." & CommandBars(i).Name '输出编号 Selection.TypeParagraph '插入新的空段落 tmps = "正在处理:" & vbTab & CommandBars(i).NameLocal & vbTab '获取按钮名称 With CommandBars(i).Controls For j = 1 To .Count '对集合中的每个按钮进行循环 Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(1) '设置首行缩进1cm Selection.Font.Bold = False '这里咱不加粗 Selection.TypeText Text:=i & "." & j '输出按钮编号 Selection.TypeText Text:=vbTab '到达下一制表位 Selection.TypeText Text:=.Item(j).Caption '输出按钮字符 Selection.TypeText Text:=vbTab Selection.TypeText Text:=.Item(j).ID '输出按钮的ID Selection.TypeText Text:=vbTab On Error Resume Next '有的按钮没有faceid,作个捕捉 Set tmpConF = .Item(j) '把按钮赋给临时变量 tmpConF.CopyFace '拷贝按钮的图标 Selection.Paste '输出图标 Selection.TypeParagraph '插入新段 If (i Mod Int(.Count / 21 + 1)) = 0 Then '限制显示字符的个数 tmps = tmps & "☆" StatusBar = tmps '状态栏输出 End If Next End With Next StatusBar = False '取消状态栏输出 Set tmpConF = Nothing Debug.Print Now() End Sub '******************************************************

1. 代码运行正常，满足要求。

2. 考虑得很周到,有页面设置,字符限制,状态栏提示,好.

3. 过多的SELECTION对象的使用,使程序无法进一上精简.

4. 没有考虑到图片插入/粘贴时的WORD选项设置.

5. 错误处理在本题中,可以以其它方法进行判断更好一些.

[此贴子已经被守柔于2005-11-21 6:24:26编辑过]

lg_cai

作了好几天，终于做出来了，主要是运行时间太长，不知道能否再优化，先传上来再说

konggs

Option Explicit Sub 工具栏命令列表() Dim X As Byte Dim i As CommandBar, n As CommandBarControl, j As Paragraph Dim A%, B%, s% Debug.Print Timer Application.ScreenUpdating = False '关闭屏幕更新 页眉页脚 制表位 ActiveDocument.Paragraphs(1).LeftIndent = CentimetersToPoints(1) '左缩进为1 For Each i In Application.CommandBars '在命令栏中循环 On Error Resume Next '忽略错误 A = A + 1 '命令栏计数器 Selection.InsertAfter A & "." & i.Name & vbCrLf For Each n In i.Controls '在命令栏i中的控件集合中循环 B = B + 1 '一级控件计数器 Selection.InsertAfter A & "." & B & vbTab & n.Caption & vbTab & "ID:＝" & n.ID & vbTab s = n.ID face (s) On Error Resume Next '忽略错误 Next B = 0 '复零 Next 段落设置 Application.ScreenUpdating = True '恢复屏幕更新 Debug.Print Timer Application.CommandBars("Standard").Controls(1).FaceId = 2520 '恢复第一个的“新建”默认图标 End Sub Sub 页眉页脚() Dim myrange As Range Dim range1 As Range With ActiveDocument.Sections(1) With .Headers(wdHeaderFooterPrimary).Range '设置页眉 .Text = "Word工具栏/命令列表" '页面上的文字 .Font.Name = "华文细黑" '文字的格式 .Font.Size = "16" .ParagraphFormat.Alignment = wdAlignParagraphCenter '居中对齐 End With Set myrange = .Footers(wdHeaderFooterPrimary).Range '设置页眉 NormalTemplate.AutoTextEntries("第 X 页 共 Y 页").Insert Where:=myrange '插入自动图文集中的域代码 myrange.ParagraphFormat.Alignment = wdAlignParagraphRight '页脚右对齐 End With End Sub Sub 制表位() With ActiveDocument.Paragraphs(1).TabStops .Add Position:=CentimetersToPoints(2.5) '2.5厘米处第一个制表位 .Add Position:=CentimetersToPoints(11) '11厘米处第一个制表位 .Add Position:=CentimetersToPoints(14) '14厘米处第一个制表位 End With End Sub Sub 段落设置() Dim apar As Paragraph For Each apar In ActiveDocument.Paragraphs If VBA.InStr(apar, "ID") = 0 Then '如果段落中有"ID" apar.LeftIndent = CentimetersToPoints(0) '则左缩进为0 apar.Range.Font.Bold = True '而且加粗 End If Next apar End Sub Sub face(s As Integer) Options.PictureWrapType = wdWrapMergeInline '图片设为嵌入型 With Application.CommandBars("Standard").Controls(1) .FaceId = s '利用第一个图标来复制、粘贴 .CopyFace Selection.EndKey Unit:=wdStory Selection.Paste Selection.InsertBefore Chr(13) End With End Sub

'******************************************************************

1. 代码运行正常，满足要求。

2. 有图片插入粘贴时WORD选项设置,不错.

3. 过多的SELECTION对象的使用,使程序无法进一上精简.

4. 整个代码比较庸肿,效率不高,特别是遍历段落,处理得不够好.

5. 错误处理在本题中,可以以其它方法进行判断更好一些.

6. FACEID的复制与粘贴,掌握得不够.

[此贴子已经被守柔于2005-11-21 6:29:38编辑过]