如何将两份WORD文档按题目序号结合排在一起

jackyxong

hhjjpp 发表于 2016-7-29 16:40
摆脱过多的光标操作：

另外还有一个问题，如果答案中有图片的，图片会丢失吗？
比如地理，答案可能就是一张地图。

hhjjpp

jackyxong 发表于 2016-8-1 21:38
另外还有一个问题，如果答案中有图片的，图片会丢失吗？
比如地理，答案可能就是一张地图。

只要你答案里没有图！

hhjjpp

jackyxong 发表于 2016-8-1 21:36
非常感谢，经过测试，大部分能成功，但目前有二个地方错位，已经在文档里面标识出来并写出了批注。
另外 ...

把thisdocument.path，改成C:\Users\Administrator\Desktop即可

jackyxong

hhjjpp 发表于 2016-8-1 22:09
只要你答案里没有图！

答案里面是有图片的，比如说现在答案里面有一个答案或解析的小图标图片，但复制过来没有了。
合成的文档，如果答案里面包含了图片，复制过来图片变成了“/”，这个能不能改？
另外有插错位置的，是行算错了吗？

hhjjpp

jackyxong 发表于 2016-8-3 09:21
答案里面是有图片的，比如说现在答案里面有一个答案或解析的小图标图片，但复制过来没有了。
合成的文档 ...

插错的可以仔细检查代码找到原因，这个肯定可以办到；而且这也是用paragraph第二种方案才有的！

但答案中的图片就很难办了，关键是如何能确定文本与图片的相对位置！ActiveDocument.Shapes(2).Top之类的位置检测是非法的！

jackyxong

hhjjpp 发表于 2016-8-3 19:36
插错的可以仔细检查代码找到原因，这个肯定可以办到；而且这也是用paragraph第二种方案才有的！

但答 ...

嗯，那看来对理科的答案图片还是没有什么好的办法。

hhjjpp

               Selection.MoveUp Unit:=wdLine, Count:=1  
应该用wdLine,而非wdParagraph,因为若该段有两行以上时,下面的Selection.EndKey语句会移至该段首行行尾,而非段尾

jackyxong

hhjjpp 发表于 2016-8-6 11:08
Selection.MoveUp Unit:=wdLine, Count:=1  
应该用wdLine,而非wdParagraph,因为若该段有 ...

经调试后，可以解决之前插入位置错误的问题，但有时会报错下面此位置：
Selection.InsertAfter Chr(13) & brr(i - 1)

现在最想解决答案中有图片的问题，有没有什么好的对策？

hhjjpp

jackyxong 发表于 2016-8-8 11:01
经调试后，可以解决之前插入位置错误的问题，但有时会报错下面此位置：
Selection.InsertAfter Chr(13) ...

图片的问题没办法，微软对word就没怎么在心上

不一定是Selection.InsertAfter Chr(13) & brr(i - 1)有问题，有可能使与之有关的其他语句，有问题一定要具体明确，才好调试查找

duquancai

按照一楼附件做的，下载附件只需打开“题目”这个文档，进入VBE编辑器，执行如下代码！！！

1. Sub 插入答案()
   
2.    Dim col As New Collection, k%, j%, str$, x&, y&
   
3.    Dim mt, mh, oRang As Range, aRang As Range, n&, m&
   
4.    Dim TMdoc As Document, DAdoc As Document
   
5.    Application.ScreenUpdating = False
   
6.    Set TMdoc = ThisDocument
   
7.    Set DAdoc = Documents.Open(ThisDocument.Path & "\答案.docx", Visible:=False)
   
8.    With CreateObject("vbscript.regexp")
   
9.       .Pattern = "^\d+\.(?:(?!^\d+\.|^[一二]|/\r).)+"
   
10.       .Global = True: .IgnoreCase = False: .MultiLine = True
    
11.       For Each mt In .Execute(DAdoc.Content)
    
12.          k = k + 1: m = mt.FirstIndex: n = mt.Length
    
13.          Set oRang = DAdoc.Range(m, m + n)
    
14.          oRang.MoveStart 1, 2: oRang.MoveEnd 1, -1: col.Add oRang, CStr(k)
    
15.       Next
    
16.    End With
    
17.    m = 0: n = 0: k = 0
    
18.    str = Replace(TMdoc.Content, Chr(7), "")
    
19.    With CreateObject("vbscript.regexp")
    
20.       .Pattern = "^\d+\.(?:(?!^\d+\.|^[一二]|知识点|选择题).)+"
    
21.       .Global = True: .IgnoreCase = False: .MultiLine = True
    
22.       For Each mh In .Execute(str)
    
23.          k = k + 1: m = mh.FirstIndex: y = mh.Length
    
24.          Set aRang = TMdoc.Range(m + x, m + x + y)
    
25.          With aRang
    
26.             If aRang.Tables.Count > 0 Then
    
27.                .Collapse: .MoveEndUntil Chr(7): .MoveEnd 1, -1
    
28.                .InsertAfter Chr(13): .Collapse 0
    
29.                .FormattedText = col(k).FormattedText: .Font.ColorIndex = 6
    
30.             Else
    
31.                .InsertAfter Chr(13): .Collapse 0: .MoveEnd 1, -1
    
32.                .FormattedText = col(k).FormattedText: .Font.ColorIndex = 6
    
33.             End If
    
34.          End With
    
35.          n = Len(col(k).Text) + 1: x = x + n
    
36.       Next
    
37.    End With
    
38.    DAdoc.Close 0
    
39.    Application.ScreenUpdating = True
    
40. End Sub

复制代码