表中身份证号把相对应的以身份证号命名的照片插入到相应的单元格中出错

pc1963

根据《培训学员登记表》中身份证号把相对应的以身份证号命名的图片插入到相应的单元格中。（学员照片文件夹放在D盘）
在《培训学员登记表》中输入身份证号运行插入照片：出现“此操作导致一些合并单元格被拆散”是否继续？ 确定后，程序出错，表格错位。
请大侠帮助修改程序一下。谢谢！！

pc1963

苏子龙

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Address = "$B$5" Then
   
3.         Application.EnableEvents = False '关闭单元格触发，为下面单元格变化不再触发此程序
   
4.         ActiveSheet.DrawingObjects.Select
   
5.         Selection.Delete
   
6.         Dim Ml#, Mt#, Mw#, Mh#
   
7.         Dim Arr, i%
   
8.         Ml = Range("i4:I7").Left
   
9.         Mt = Range("i4:I7").Top
   
10.         Mw = Range("i4:I7").Width
    
11.         Mh = Range("i4:I7").Height
    
12.         Sheet39.Shapes.AddShape(msoShapeRectangle, Ml, Mt, Mw, Mh).Select
    
13.         '    Selection.ShapeRange.Fill.UserPicture _
    
14.         '       "d:\学员照片" & Target.Text & ".jpg"
    
15.         On Error Resume Next '当身份证没有时继续下一步
    
16.         Selection.ShapeRange.Fill.UserPicture _
    
17.             ThisWorkbook.Path & "\学员照片" & Target.Text & ".jpg"
    
18.         Range("B4,D4,G4:H4,B6:H6,B7:C7,B15:C15,D16:F16,G15:I15").ClearContents
    
19.         Arr = Sheet2.Range("A3:Q" & Sheet2.Range("A65536").End(3).Row)
    
20.         For i = 1 To UBound(Arr)
    
21.             If Range("B5") = Arr(i, 5) Then
    
22.                 Range("B4") = Arr(i, 2)
    
23.                 Range("D4") = Arr(i, 3)
    
24.                 Range("G4") = Arr(i, 6)
    
25.                 Range("B6") = Arr(i, 7)
    
26.                 Range("B7") = Arr(i, 8)
    
27.                 Range("D16") = Arr(i, 15)
    
28.                 Range("B15") = Arr(i, 9)
    
29.                 Range("G15") = Arr(i, 16)
    
30.                 GoTo ed
    
31.             End If
    
32.         Next
    
33.         MsgBox "没有身份证号为〖 " & Range("$b$5") & " 〗的登记"
    
34.    
    
35.     End If
    
36. ed:
    
37.     Application.EnableEvents = True
    
38. End Sub

复制代码

pc1963

大侠:你好!   

Private Sub Worksheet_Change(ByVal Target As Range)
   
If Target.Address <> "$B$5" Then Exit Sub
Dim shp As Shape, rng As Range, myPath$, Arr, i&
For Each shp In ActiveSheet.Shapes
    If shp.Type = msoAutoShape Then
        shp.Delete
    End If
Next
    Set rng = Range("i4:I7")
    myPath = ThisWorkbook.Path & "\学员照片"
    ML = rng.Left
    MT = rng.Top
    MW = rng.Width
    MH = rng.Height
    Sheet39.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
    Selection.ShapeRange.Fill.UserPicture _
       "d:\学员照片\" & Target.Text & ".jpg"

这个照片放在单元格i4:i7中的。如果照片放在合并单元格（列i j k，行是4、5、6）怎样编写