请教大侠，这个word 数据行合并脚本怎么写？

jazzson

    因为在笔记整理的时候，需要把附件中的word 文件从第二行开始     如果下一行是文本，就把当前行和下一行合并。

    如果下一行是图片，就跳过当前行和图片。继续循环处理直到完毕

   搜索了论坛，但是代码还是看的不是太懂。特请高手求助，谢谢  

zhanglei1371

1. Sub hebing()
   
2. Dim pa As Paragraph, j%
   
3.     ActiveDocument.Range.InsertAfter Chr(13)
   
4.     j = ActiveDocument.Paragraphs.Count
   
5.     For i = j - 1 To 1 Step -1
   
6.         Set pa = ActiveDocument.Range.Paragraphs(i)
   
7.         If pa.Range.InlineShapes.Count = 0 And Len(pa.Range) < 5 And Len(pa.Range) > 1 And pa.Next.Range.InlineShapes.Count = 0 Then
   
8.             '若段落内容满足:长度在1和5之间,下面段落不是图片,就合并
   
9.             ActiveDocument.Range(pa.Range.End - 1, pa.Range.End) = ""
   
10.             j = ActiveDocument.Paragraphs.Count '更新文档段落数
    
11.         End If
    
12.     Next
    
13. End Sub

复制代码

QQ214189912

...............

jazzson

QQ214189912 发表于 2018-8-12 21:33
...............

谢谢老大帮助，代码运行效果很好！

Sub test()

    Dim intx As Integer, objRange As Range
   
    With Word.ActiveDocument
    For intx = .Paragraphs.Count To 2 Step -2

    If .Paragraphs(intx).Range.InlineShapes.Count = 0 Then

    Set objRange = .Range(.Paragraphs(intx).Range.Start, .Paragraphs(intx).Range.Start)
    objRange.Select
    Selection.TypeBackspace

    End If

    Next intx

    End With
End Sub

jazzson

zhanglei1371 发表于 2018-8-12 21:23

谢谢老大帮助，看了半天help ，基础不行看的头晕

代码运行效果很好，合并起来结果展示才发现原来还是考虑不周。能否帮忙修改一下在合并之后，再统一把图片按顺序放在最后呢？

jazzson

zhanglei1371 发表于 2018-8-12 21:23

     谢谢，VBA 合并已经成功，但是在导入 xmind 的时候，发现还需要把合并的文本都设置成标题二，否则不能导入 xmind , 我参考了 http://club.excelhome.net/thread-1246366-1-1.html 这个帖子修改标题，但是失败了 ；-（   。另外，还想把所有的图片，都统一按照顺序拷贝一份粘贴到文章的后边，还恳请高手帮忙

     万分感谢

     

jazzson

zhanglei1371 发表于 2018-8-12 21:23

    还恳请高手继续指点一下：

    VBA 合并效果很好，我现在把Word 导入xmind 的时候。xmind 要求导入的文本必须是标题二 格式，搜索论坛照猫画虎搬了一段代码，但是失败了，请问如果要把合并的文本内容设置成标题二，该如何编写代码呢？
    另外，如果想把所有的图片，都拷贝一份。粘贴到文章的后面、或者新写入一个文件中，该怎么办呢？

Sub hebing_v2()

    Dim pa As Paragraph, j%
    ActiveDocument.Range.InsertAfter Chr(13)
    j = ActiveDocument.Paragraphs.Count
    For i = j - 1 To 1 Step -1
        Set pa = ActiveDocument.Range.Paragraphs(i)
        If pa.Range.InlineShapes.Count = 0 And Len(pa.Range) < 5 And Len(pa.Range) > 1 And pa.Next.Range.InlineShapes.Count = 0 Then
            '若段落内容满足:长度在1和5之间,下面段落不是图片,就合并
            ActiveDocument.Range(pa.Range.End - 1, pa.Range.End) = ""
            j = ActiveDocument.Paragraphs.Count '更新文档段落数
            
            
            Selection.HomeKey unit:=wdLine
            Selection.EndKey unit:=wdLine, Extend:=wdExtend
            Selection.ParagraphFormat.OutlineLevel = wdOutlineLevel2
        End If
    Next
End Sub

ming0018

鉴于你的要求一个又一个，我给出以下建议：
1.自己学习
2.2楼上有付费的
3.等好心人有空慢慢给你写代码

jazzson

ming0018 发表于 2018-8-13 08:35
鉴于你的要求一个又一个，我给出以下建议：
1.自己学习
2.2楼上有付费的

  谢谢提醒 ；-）