求助：WORD文件按给定条件拆分

lhdcxz

有一个WORD文档，里面有若干个大小不等的表格，请问：如何 用VBA代码 按照给定的条件（比如：按照字体大小“宋体、小一号”）自动 拆分为几个单独的WORD文件存放在同一个文件夹下？
WORD文件拆分.rar (9.62 KB, 下载次数: 30)

2013-1-5 17:10 上传

点击文件名下载附件

dajiahaoxinku12

复制，剪贴到新文档中吧           

lhdcxz

谢谢关注。不是用复制粘贴。而是用代码（对不起，是我叙述不足）。

lhdcxz

各位高手，请路过的时候看看。

lhdcxz

buddha_2002 发表于 2013-1-25 14:43
判断方法，段落中存在“表”字，并且字体为黑体

非常感谢！一定仔细拜读大作！

buddha_2002

简单写了一个




Sub test1()
   
    Dim p As Paragraph
    Dim i As Long
    Dim row() As Long
    Dim v_range As Range
   
    i = 0
   
    Application.ScreenUpdating = False
   
    ReDim row(0) As Long
   
    '获取段落
    For i = 1 To ActiveDocument.Paragraphs.Count
            
        s = ActiveDocument.Paragraphs(i).Range.Text     '取段落文本
               
        '判断方法，段落中存在“表”字，并且为黑体
        pos = InStr(1, s, "表")
        blodflag = ActiveDocument.Paragraphs(i).Range.Font.Bold
        
        If pos > 0 And blodflag Then
            
            row(UBound(row)) = i
            
            ReDim Preserve row(UBound(row) + 1) As Long
                                
        End If
        
    Next i
   
    '按段落生成新文档
    For i = 0 To UBound(row) - 1
        
        '选择区域，从标题开始，至下一个标题为止。如果是最后一个段落，则取到文档末尾，否则取下一个段落之前
        If i = UBound(row) - 1 Then
            Set v_range = ActiveDocument.Range(ActiveDocument.Paragraphs(row(i)).Range.Start, ActiveDocument.Paragraphs(ActiveDocument.Paragraphs.Count).Range.End)
        Else
            Set v_range = ActiveDocument.Range(ActiveDocument.Paragraphs(row(i)).Range.Start, ActiveDocument.Paragraphs(row(i + 1)).Range.Start - 1)
        End If
               
        v_name = ActiveDocument.Paragraphs(row(i)).Range.Text     '获取标题
               
        v_name = Mid(v_name, 1, Len(v_name) - 1)                  '去掉段落标记
               
        v_name = ActiveDocument.Path + "\" + v_name + ".doc"      '以标题作为文件名
        
        v_range.Copy                    '复制
               
        'Set file = Documents.Add(Template:=ActiveDocument.Path + "\表11.dotx", Visible:=False)  '按模板新建文档
        Set file = Documents.Add(Visible:=False)  '按模板新建文档
                        
        file.Paragraphs(1).Range.Paste  '粘贴内容
                                
        file.SaveAs2 FileName:=v_name, fileformat:=wdFormatDocument '保存文件
               
        file.Close                      '关闭文件
   
    Next i
   
    Application.ScreenUpdating = True
   

End Sub

buddha_2002

判断方法，段落中存在“表”字，并且字体为黑体

buddha_2002

不知道我说明白了没~~~~~~

buddha_2002

看了一下，你的word文档版式有过调整，所以生成的文档会是原始的，如果想使用调整过的模板，就把word文件存为模板，内容为空。
使用被注释的那句代码就行了，注意替换里面的模板名称

lhdcxz

buddha_2002 发表于 2013-1-25 17:07
不知道我说明白了没~~~~~~

说的很清楚。谢谢！