根据目录添加对应照片，代码已经形成，请老师进来看一看，问题描述已更新了，谢谢

40525299999

代码作用：根据word文件里面的三级目录（手动输入到word里面的，即姓名清单），运行代码自动加入对应路径的图片，并根据设置调整好大小；

目前问题：该代码不够智能，必须在每个三级目录后增加一行空白行，才能完美得到想要的结果；（即，第一种完美，第二种不完美）

第一种情况

第二种情况

解决问题：每个三级目录之间不用事先键入一行空白行，代码能完美运行，即第二种情况可以完美运行；


    Selection.TypeParagraph  应该是这个代码，但是我试了很多次，达不到我要的结果，请老师帮助


附件里面我是添加了空行的，如果删除掉空行，只保留目录，就可以运行的话，就完美解决问题了




根据目录自动粘贴-小图.rar (1.06 MB, 下载次数: 37)

2018-6-6 15:30 上传

点击文件名下载附件

40525299999

看来确实是个难题了

duquancai

40525299999 发表于 2018-6-7 09:40
看来确实是个难题了

Sub main()
    Dim k$, p As Paragraph, mypath$, doc As Document
    Set doc = ActiveDocument
    If doc.ListParagraphs.Count < 1 Then Exit Sub
    mypath = ThisDocument.Path & "\照片信息\"
    Call Preprocessing(doc)
    For Each p In doc.ListParagraphs
        If p.Range.ListFormat.ListLevelNumber = 3 Then
            k = Replace(Replace(p.Range.Text, vbCr, ""), " ", "")
            With p.Range
                .Collapse 0: .Text = vbCr: .Collapse: .Style = "正文"
                If Len(Dir(mypath & k & "_身份证正面.jpg")) Then
                    Call InsetPicture(.Duplicate, mypath & k & "_身份证正面.jpg")
                    .Start = .End + 1
                End If
                If Len(Dir(mypath & k & "_身份证背面.jpg")) Then
                    Call InsetPicture(.Duplicate, mypath & k & "_身份证背面.jpg")
                End If
            End With
        End If
    Next
    MsgBox "OK!"
End Sub
Sub Preprocessing(doc As Document)
    If doc.InlineShapes.Count > 0 Then
        For i = doc.InlineShapes.Count To 1 Step -1
            doc.InlineShapes(i).Delete
        Next
    End If
    doc.Content.Find.Execute "^13{2,}", , , -1, , , , , , "^p", 2
End Sub
Sub InsetPicture(rang As Range, pf)
    With rang.InlineShapes.AddPicture(pf, 0, True)
        .Width = CentimetersToPoints(8.2)
        .Height = CentimetersToPoints(5.2)
    End With
End Sub

duquancai

40525299999 发表于 2018-6-7 09:40
看来确实是个难题了

我被你的激将法击中要害了！代码在审核中，请耐心等待。

40525299999

duquancai 发表于 2018-6-7 11:58
我被你的激将法击中要害了！代码在审核中，请耐心等待。

牛A和牛C居然都没出现，然后杜老师，您来了......

duquancai

40525299999 发表于 2018-6-7 13:41
牛A和牛C居然都没出现，然后杜老师，您来了......

你这题目不是什么难题，是因为太简单，所以没人愿意出手。