如何使用VBA实现，根据编号选择内容，并呈现在新的文本中

亦菩提亦明镜

问题详细描述见附件：
辛苦各位大侠
如何根据编号选择内容.rar (49.2 KB, 下载次数: 43)

2014-10-21 16:07 上传

点击文件名下载附件

该贴已经同步到 亦菩提亦明镜的微博

羊刀在手

感觉也不会  在线一起等

huanger999

1. Sub new_doc()
   
2. Dim mydoc As Document  '现有文档
   
3. Dim newdoc As Document  '新建文档
   
4. 
   
5. strinput = InputBox("请输入题号，以半角逗号分隔！")
   
6. If strinput = False Then
   
7.   'MsgBox "没有输入"
   
8.   Exit Sub
   
9. End If
   
10. '建立一个列表，index对应题号，值对应段落号
    
11. strlist = "id"
    
12. myMax = 0
    
13. For i = 1 To ActiveDocument.Paragraphs.Count
    
14.   If ActiveDocument.Paragraphs(i).Range.ListFormat.ListString <> "" Then
    
15.     strlist = strlist & "," & i
    
16.     myMax = CInt(Replace(ActiveDocument.Paragraphs(i).Range.ListFormat.ListString, ".", ""))
    
17.   End If
    
18. Next i
    
19. strlist = strlist & "," & ActiveDocument.Paragraphs.Count
    
20. strArray = Split(strlist, ",")
    
21. 
    
22. orderlist = strinput
    
23. orderArray = Split(orderlist, ",")
    
24. Set mydoc = ActiveDocument
    
25. Set newdoc = Documents.Add
    
26. strStatus = "ID copyed"
    
27. For i = 0 To UBound(orderArray)
    
28.   questionID = CInt(orderArray(i))
    
29.   If questionID <= myMax Then
    
30.     mydoc.Activate
    
31.     mystart = mydoc.Paragraphs(CInt(strArray(questionID))).Range.Start
    
32.     myend = mydoc.Paragraphs(CInt(strArray(questionID + 1))).Range.Start
    
33.     mydoc.Range(mystart, myend).Copy
    
34.     newdoc.Activate
    
35.     Selection.PasteAndFormat (wdPasteDefault)
    
36.     strStatus = strStatus & ", " & orderArray(i)
    
37.   End If
    
38. Next i
    
39. MsgBox strStatus
    
40. End Sub
    
41. 
    

复制代码

亦菩提亦明镜

huanger999 发表于 2014-10-21 21:49

非常感谢&#128591;

kqbt

方法很巧妙，学习了！