WORD表格里几百个名字需要按照名字导入照片。有什么便捷方法吗求助大神帮帮忙，

tmhy1977

附件是求大神示例用的，400多个人一个一个弄太费时间。大神帮帮忙

tmhy1977

自己顶一下 ，大神帮帮忙吧

duquancai

tmhy1977 发表于 2018-3-27 10:08
自己顶一下 ，大神帮帮忙吧

根据你提供附件，可以用如下代码实现：

Sub test()
    Dim f$, ph$, d As Object, aDoc As Document, tb As Table, c As Cell, pf$
    Application.ScreenUpdating = False
    Set aDoc = ActiveDocument
    If aDoc.Tables.Count = 0 Or aDoc.Tables.Count > 1 Then Exit Sub
    ph = ThisDocument.Path: f = Dir(ph & "\*.jpg")
    Set d = CreateObject("Scripting.Dictionary")
    Do While f <> ""
        d(Left(f, InStrRev(f, ".") - 1)) = ph & "\" & f
        f = Dir()
    Loop
    If d.Count = 0 Then Exit Sub
    k = d.keys: t = d.items
    Set tb = aDoc.Tables(1)
    For i = 2 To tb.Columns(3).Cells.Count
        With tb.Columns(3).Cells(i).Range
            .End = .End - 1
            If d.Exists(.Text) Then
                pf = d(.Text)
                .Move 12, 4: .Expand 12: .Text = Empty
                .InlineShapes.AddPicture pf, 0, -1
            Else
                .Move 12, 4: .Expand 12: .Text = Empty
            End If
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox "ok!"
End Sub

tmhy1977

duquancai 发表于 2018-3-27 18:23
根据你提供附件，可以用如下代码实现：

Sub test()

谢谢大神 我去试试

金鳳凰

楼上大神厉害，学到了。非常非常棒。

ammyc

duquancai 发表于 2018-3-27 18:23
根据你提供附件，可以用如下代码实现：

Sub test()

老大，解释下“   .Move 12, 4: .Expand 12: .Text = Empty”，特别是其中的数字参数“12”，谢谢你！

zhanglei1371

ammyc 发表于 2021-2-28 12:29
老大，解释下“   .Move 12, 4: .Expand 12: .Text = Empty”，特别是其中的数字参数“12”，谢谢你！

wdUnite常量：
1 -wdCharacter；2-wdWord；3-wdSentence；4-wdParagraph；5-wdline（selection专用）；6-wdStory；wdScreen（7）；8-wdSection；9-wdcolumn；10-wdrow；wdwindow（11）；12-wdcell；15-wdtable
高手们写代码喜欢隐晦

ammyc

zhanglei1371 发表于 2021-2-28 19:32
wdUnite常量：
1 -wdCharacter；2-wdWord；3-wdSentence；4-wdParagraph；5-wdline（selection专用）； ...

谢谢回复！弄明白了