|
应网友要求所作，用于保留原有文本内容（主要是中繁体文本/版本间不同）形式，本代码未经详细测试，对于多节可能不适用。
以下代码供参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-9-9 5:32:32
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 0008^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub TextToPicture()
Dim NumberPages As Integer, i As Integer, TF As Boolean
Dim lngStart As Long, lngEnd As Long, myRange As Range
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕更新
With ActiveDocument
'取得本文档的总页数
NumberPages = .Content.Information(wdNumberOfPagesInDocument)
'将分节符替换为分页符
For i = NumberPages To 1 Step -1 '进行一个循环
'取得第一个分页的起始位置
lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start
'取得第一个分页的最后位置(是下一页的开始位置)
lngEnd = VBA.IIf(i = NumberPages, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + 1).Start)
'定义一个RANGE对象
Set myRange = .Range(lngStart, lngEnd)
myRange.Select
Selection.Copy '复制
TF = myRange.Find.Execute(findtext:="^m")
Selection.PasteSpecial DataType:=wdPasteMetafilePicture
'wdPasteEnhancedMetafile
.Shapes(.Shapes.Count).ConvertToInlineShape
'如果原文档中带有手动分页符则加入手动分页符以保持原有"格式"
If TF = True Then Selection.InsertAfter Chr(12)
Next
End With
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
'----------------------
wXY6Ys8o.rar
(17.02 KB, 下载次数: 203)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-9-9 05:31
