WORD单页复制[带线条和框]

ludingsky

大家好是这样的

就是我先是画了N个页文档,有文字有表还有绘图工具画的线组成的图

现在我公司要求有时某页不要要删掉,掉如多带有图的,那是N个线图和框组成的,要一个个删很累的

有没什么办法可以复制单节全部内容

常规复制不会复制线条的文本框的.大家什么办法

我试用用宏拆分成单节,但线条和框还拆了后,单个文件里丢失的了

在线等急

Sub SaveAsPage()
    Dim PageCount As Integer, StartRange As Long, EndRange As Long, MyRange As Range, Fn As String, MyDoc As Document
    Dim SaveFileName$
    SaveFileName = "c:\zj"         '设置文件保存的路径和文件名，这里为c:\zj*.doc,*为页码序号
    On Error Resume Next
    PageCount = Selection.Information(wdNumberOfPagesInDocument)
   ThisDocument.Range(0, 0).Select    '将光标移至文档起点
    For i = 1 To PageCount    '设置循环次数
        StartRange = Selection.Start    '取得该页的第一个字符位置
        Selection.EndKey Unit:=wdLine    '将光标移动到该页首行的最后位置
        Fn = ThisDocument.Range(StartRange, Selection.End - 1)    '-1的目的是防止该页首行含有段落标记,导致出错.
        If i = PageCount Then    '如果循环到达最后一页
            EndRange = ThisDocument.Content.End    '将文档最后位置赋值于EndRange
        Else
            Selection.GoToNext (wdGoToPage)    '否则,将下一页的起始位置赋值于EndRange(等同于本页的最后位置)
            EndRange = Selection.Start
        End If
        Set MyRange = ThisDocument.Range(StartRange, EndRange)    '将本页中的内容进行复制
        MyRange.Copy
        Set MyDoc = Documents.Add    '新建一空白文档
        MyDoc.Range(0, 0).Paste    '在文档开始处粘贴
        ActiveDocument.SaveAs FileName:=SaveFileName & i & ".doc", FileFormat:= _
                              wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
                              True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
                              False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
                              SaveAsAOCELetter:=False
        MyDoc.Close    '关闭文档
    Next
End Sub

以上VB不能实现

[此贴子已经被守柔于2007-3-16 6:46:29编辑过]

ludingsky

n尽没人会?

守柔

QUOTE:

以下是引用ludingsky在2007-3-15 0:22:48的发言：

n尽没人会?

我希望楼主这样:

1:不要使用跪求，发贴时我们已经提示过了。

2.请表达清楚你的意思,我看了两遍,依然没有明白你的意思,何况错别字多了让人没有兴趣.

3.代码从何而来?

4.上传附件.