说明: 这是一个自动向模板添加右键菜单的范例。 范例意义:通过低宏打开的文档,自动向模板添加名为"Text"的工具栏的一个命令,此命令的作用在于以无格式文本方式粘贴来自于HTML格式的文本内容,并自动完成空行的删除,并复制. 主要用途: 网友们对于WORD帮助文件中的复制的内容,往往不加甄别直接粘贴于网页的回复贴子中,造成不必要的误会.如果你使用了本命令"粘贴文本并删除空行命令",则可以方便地解决此类问题. 操作方法: 选中并复制需要粘贴的内容,回到WORD页面中,右击,点选"粘贴文本并删除空行命令",则自动会在光标所在处以无格式文本形式粘贴,并自动删除其中的空白段落.如果你需要,无需再次复制,直接回到网页中,粘贴即可. 以下代码供网友参考: '* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-1-31 11:32:15 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* -----------------------------
Private Sub Document_Open() Application.OrganizerCopy Source:=Me.FullName, _ Destination:=NormalTemplate.FullName, Name:="AddText", _ Object:=wdOrganizerObjectProjectItems End Sub '---------------------- '* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-1-31 11:32:31 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [标准模块-AddText]^' '* -----------------------------
'* +++++++++++++++++++++++++++++ '* Created By 守柔(ShouRou)@ExcelHome 2005-1-31 6:13:59 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* ----------------------------- Sub AutoOpen() Dim MyBar As CommandBarControl On Error Resume Next Application.CommandBars("Text").Controls("粘贴文本并删除空行").Delete Set MyBar = Application.CommandBars("Text").Controls.Add(Before:=4) With MyBar .Caption = "粘贴文本并删除空行" .FaceId = 480 .OnAction = "PasteAndDel" End With End Sub '----------------------
Sub PasteAndDel() Dim StartRange As Long, EndRange As Long, MyRange As Range, OldEnd As Long Dim i As Paragraph On Error Resume Next '判断剪贴板是否有内容 If Application.CommandBars.FindControl(ID:=22).Enabled = False Then Exit Sub Application.ScreenUpdating = False '原文档结束点位置 OldEnd = ActiveDocument.Content.End With Selection .Collapse Direction:=wdCollapseEnd '折叠到选定位置的末端 StartRange = .Start '获得一个位置 .Range.PasteSpecial DataType:=wdPasteText '光标处选择性粘贴为文本格式 '获得粘贴后文本的末位置 EndRange = StartRange + ActiveDocument.Content.End - OldEnd ActiveDocument.Range(StartRange, EndRange).Select '选定该段文本 For Each i In .Paragraphs '指定段落中循环 If Len(i.Range) = 1 Then i.Range.Delete '如果为空行则删除 Next .Copy '重新复制,以便调用 End With Application.ScreenUpdating = True End Sub '---------------------- '---------------------- 以下为截图图片:
gS4IPuEY.rar
(12.12 KB, 下载次数: 227)
[此贴子已经被konggs于2007-2-9 9:11:42编辑过] |