从word里面提取文字粘贴到另外一个word文档的指定位置

开开心心1986

我要做的事情是，把一个word文档里面的特定位置的文字复制粘贴到另外一个word文档的特定位置。一个原始文档对应一个目标文档。
有几百个这样的原始文档，希望能批量处理。
谢谢。
见附件

dingboy_VBA

比较简单的办法，是将Word的内容整理成规范的格式，然后导入到Excel中，进行内容变换，变换完成之后，再复制到Word中来。

我经常这么干，特别是写枯燥的代码时，利用这种方式让Excel来生成一些形式相似的代码，特别是常量的定义。

413191246se

赞成2楼的看法，格式统一规范，提供样稿附件。

zhanglei1371

先将姓名地址提取出来到excel 然后邮件合并

开开心心1986

dingboy_VBA 发表于 2012-12-23 00:48
比较简单的办法，是将Word的内容整理成规范的格式，然后导入到Excel中，进行内容变换，变换完成之后，再复制 ...

已经上传附件，求详细指点

开开心心1986

413191246se 发表于 2012-12-23 02:21
赞成2楼的看法，格式统一规范，提供样稿附件。

样稿附件已经提供。求更具体的指导，谢谢

开开心心1986

zhanglei1371 发表于 2012-12-23 05:09
先将姓名地址提取出来到excel 然后邮件合并

我之前没有上传样稿，所以未能完整表达我的意思，你说的办法好像不是很合适。
现在上传了样稿，求详细指点。谢谢

413191246se

    声明一下：虽然热心无限，但因水平问题，只能算完成了一半或多一点吧，感觉复杂，似应用到Range的问题，要想完美解决，须请sylun大侠解决，仅为楼主提供一定参考吧！（光标焦点位于原始文档后应用，可以设置本宏为热键 F4，方便应用。另，楼主不必着急，可等待高手进一步完善。）
[code=vb]Sub 提取文字()
    Dim y As String
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Text = "事实与理由"
    Selection.Find.Execute

    Selection.EndKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paragraphs(1).Range.Select
    y = Selection.Text
    y = Left(y, Len(y) - 1)

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Text = "甲方请求"
    Selection.Find.Execute
    Selection.HomeKey Unit:=wdLine
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.Copy

' 新建文档
    Documents.Add DocumentType:=wdNewBlankDocument

' 生成目标文档
    Selection.TypeText Text:="争议解决方案草稿" & vbCr
    ActiveDocument.Paragraphs(2).Range.Delete
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeText Text:=vbCr & "经研究，XXXXXXXXX存在甲种纠纷，简介如下。" & vbCr & "甲方声称，"
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Text = "甲方声称，"
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=y & "纠纷因此产生，建议如下协调：" & vbCr & "一、乙方ZZZZZZZZZZ。" & vbCr & "上述协议，不违反法律规定，希望双方自愿遵守。"
    ActiveDocument.Content.Find.Execute FindText:="争议简介", ReplaceWith:="", Replace:=wdReplaceAll

' 简单排版
    Selection.WholeStory
    Selection.ClearFormatting
    Selection.ClearFormatting
    Selection.Font.Size = 14
    Selection.ParagraphFormat.LineSpacing = LinesToPoints(1.25)
    Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2
' 设置标题一
    With ActiveDocument
        .Paragraphs(1).Range.InsertParagraphBefore
        .Paragraphs(2).Range.InsertParagraphAfter
        With .Range(Start:=0, End:=.Paragraphs(3).Range.End)
            .Style = ActiveDocument.Styles(wdStyleHeading1)
            With .ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LineSpacing = LinesToPoints(1.15)
                .Alignment = wdAlignParagraphCenter
            End With
        End With
        .Paragraphs(1).Range.Font.Size = 22
        .Paragraphs(3).Range.Font.Size = 18
    End With
    With Selection.Font
        .Kerning = 0
        .DisableCharacterSpaceGrid = True
    End With
    With Selection.ParagraphFormat
        .AutoAdjustRightIndent = False
        .DisableLineHeightGrid = True
    End With
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
    Selection.HomeKey Unit:=wdStory

' 插入表格
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _
        4, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "网格型" Then
            .Style = "网格型"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = True
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = True
    End With
    Selection.TypeText Text:="拟稿人"
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="拟稿时间"
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="核稿意见"
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="打印    份"
    Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Cells.Merge
    Selection.Tables(1).Select
    Selection.Font.Size = 12
    Selection.ParagraphFormat.Space1
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
    Selection.Rows(1).Height = CentimetersToPoints(1)
    Selection.Rows(2).Height = CentimetersToPoints(2)
    Selection.Rows(2).Cells(2).Select
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Tables(1).Select
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.Tables(1).Select
    Selection.Font.Bold = False
    Selection.HomeKey Unit:=wdStory
End Sub[/code]

dnfrank

学习了，现在正头疼这个