如何快速利用乙文档的关键字提取甲文档关键字所在的页码

ahtec

我有两个word文档，其中一个word甲文档存了图片和图片说明，另外一个word乙里面做了一张表，表格2栏，一栏是图片说明，需要在另外一栏中填写word甲中对应图片说明所在的页码。请问怎么实现呢？

duquancai

你有两个word文档，请问在哪里？没看见这“两个Word文档”哦！！！！

不经意的回头

提交模拟文档，方便大家更快的帮助你。

ahtec

第一次使用，抱歉。忘了上传文档了。

ahtec

我的文档只列了个模式，实际取值大概在4000个左右。

duquancai

ahtec 发表于 2018-4-6 22:10
第一次使用，抱歉。忘了上传文档了。

注册时间2010-1-19
好多年了，还是第一次使用，你是来伸手 要代码 的吗？

duquancai

ahtec 发表于 2018-4-6 22:41
我的文档只列了个模式，实际取值大概在4000个左右。

代码放于 “WORD乙.docx”模块中》》》》》》》》》》》》》》》》》》》》》

Sub test()
    Dim Q As Range, Ip As InlineShape, Doc As Document
    Dim d As Object, myRow As Row, tDoc As Document
    Set tDoc = ThisDocument
    Set Doc = Documents.Open(tDoc.Path & "\WORD甲.docx", Visible:=0)
    If Doc.InlineShapes.Count = 0 Then Exit Sub
    Set d = CreateObject("Scripting.Dictionary")
    For Each Ip In Doc.InlineShapes
        Set Q = Ip.Range.Previous
        With Q.Paragraphs(1).Range
            .End = .End - 1
            d(Replace(.Text, " ", "")) = .Information(1)
        End With
    Next
    Doc.Close 0
    For Each myRow In tDoc.Tables(1).Rows
        s1 = myRow.Range.Cells(1).Range.Text
        s2 = myRow.Range.Cells(2).Range.Text
        s1 = Replace(Split(s1, Chr(13) & Chr(7))(0), " ", "")
        s2 = Replace(Split(s2, Chr(13) & Chr(7))(0), " ", "")
        If d.Exists(s1 & s2) Then
            myRow.Range.Cells(3).Range.Text = "WORD甲中第 " & d(s1 & s2) & " 页"
        End If
    Next
End Sub

ahtec

duquancai 发表于 2018-4-7 00:46
注册时间2010-1-19
好多年了，还是第一次使用，你是来伸手 要代码 的吗？

哎，被你发现了。

ahtec

duquancai 发表于 2018-4-7 01:23
代码放于 “WORD乙.docx”模块中》》》》》》》》》》》》》》》》》》》》》

Sub test()

万分感谢！正在学习中！因为对于我来说，WORD就是编辑文本的工具，买了好多书，都没坚持下来。