根据目录添加对应照片，代码已经形成，需要优化一下，请哪位大侠进来看一看，谢谢

40525299999

代码作用：根据word文件里面的三级目录（每一级目录之间必须事先键入一行空白行），运行代码自动加入对应路径的图片，并根据设置调整好大小；

目前问题：该代码不够智能，需要改进，增加一行插入回车符的代码，才能完美；
解决问题：每一级目录之间不用事先键入一行空白行，代码能自动识别并自动添加回车

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


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

代码见下，附件已上传

Sub CommandButton11_Click()
Dim i%, n%, mypath$, sr$
mypath = ThisDocument.Path
If ActiveDocument.ListParagraphs.Count < 1 Then Exit Sub
Application.ScreenUpdating = False
n = ActiveDocument.ListParagraphs.Count
For i = 1 To n
    ActiveDocument.ListParagraphs(i).Range.Select
    If Selection.Style = "标题 3,name" Then
        sr = Replace(Selection.Range.Text, Chr(13), "")
    End If
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
    With Selection.InlineShapes.AddPicture(FileName:="C:\000HCtelecom\PMO\0000人员\人员工具\身份证737\" & sr & "_身份证正面.jpg", SaveWithDocument:=True)
        .Width = CentimetersToPoints(8.2)
        .Height = CentimetersToPoints(5.2)
    End With
    With Selection.InlineShapes.AddPicture(FileName:="C:\000HCtelecom\PMO\0000人员\人员工具\身份证737\" & sr & "_身份证背面.jpg", SaveWithDocument:=True)
        .Width = CentimetersToPoints(8.2)
        .Height = CentimetersToPoints(5.2)
    End With
Next
Application.ScreenUpdating = True
End Sub
根据目录自动粘贴-小图.rar (1.06 MB, 下载次数: 13)

2018-5-24 16:43 上传

点击文件名下载附件

413191246se

〝屡试不爽〞是一个汉语成语，读音：lǚ shì bù shuǎng ，释义：爽，差错。意为屡次试验都没有差错。

40525299999

代码有一点点的小问题，现修改如下，替换掉附件中的代码就可以运行

1. Sub CommandButton11_Click()
   
2. Dim i%, n%, mypath$, sr$
   
3. mypath = ThisDocument.Path
   
4. If ActiveDocument.ListParagraphs.Count < 1 Then Exit Sub
   
5. Application.ScreenUpdating = False
   
6. n = ActiveDocument.ListParagraphs.Count
   
7. For i = 1 To n
   
8.     ActiveDocument.ListParagraphs(i).Range.Select
   
9.     If Selection.Style = "标题 3,name" Then
   
10.         sr = Replace(Selection.Range.Text, Chr(13), "")
    
11.     End If
    
12.     Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdMove
    
13.     With Selection.InlineShapes.AddPicture(FileName:=mypath & "\照片信息" & sr & "_页面_2.jpg",  SaveWithDocument:=True)
    
14.         .Width = CentimetersToPoints(8.2)
    
15.         .Height = CentimetersToPoints(5.2)
    
16.     End With
    
17.     With Selection.InlineShapes.AddPicture(FileName:=mypath & "\照片信息" & sr & "_页面_2.jpg",  SaveWithDocument:=True)
    
18.         .Width = CentimetersToPoints(8.2)
    
19.         .Height = CentimetersToPoints(5.2)
    
20.     End With
    
21. Next
    
22. Application.ScreenUpdating = True
    
23. End Sub

复制代码

413191246se

楼主，请在 VBE 中按 F8 逐步调试，看看有没有问题。

40525299999

413191246se 发表于 2018-5-24 23:34
〝屡试不爽〞是一个汉语成语，读音：lǚ shì bù shuǎng ，释义：爽，差错。意为屡次试验都没有差错。

谢谢你善意的提醒

413191246se

OK，楼主！三级目录，什么意思？

40525299999

413191246se 发表于 2018-6-6 00:17
OK，楼主！三级目录，什么意思？

三级目录，就是姓名，就是提前输入到word里面的姓名列表