要求在附件中样表1里，求大侠！！！！！！

penghu26

要求在附件中样表1里，求大侠！！！！！！ 附件.zip (127.11 KB, 下载次数: 14)

2015-4-17 11:55 上传

点击文件名下载附件
要求在附件中样表1里，求大侠！！！！！

sunya_0529

写个宏解决——

1. Option Explicit
   
2. 
   
3. Sub InsertPhoto()
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. Dim shp As Shape, rng As Range, adr As String, l As Single, t As Single, h As Single, w As Single
   
7. With Sheet1
   
8.   For Each shp In .Shapes '先清除表中已有照片
   
9.     If shp.Type = msoPicture Then shp.Delete
   
10.   Next
    
11.   Set rng = .Cells.Find("准考证号码", LookIn:=xlValues)
    
12.   If Not rng Is Nothing Then
    
13.     adr = rng.Address
    
14.     Do
    
15.       l = rng.Offset(0, 3).Left '插入照片的位置－左
    
16.       t = rng.Offset(0, 3).Top '插入照片的位置－上
    
17.       h = rng.Offset(0, 3).Height * 2.18 '照片的高度
    
18.       w = rng.Offset(0, 3).Width '照片的宽度
    
19.       .Shapes.AddPicture ThisWorkbook.Path & "/照片/" & rng.Offset(0, 1).Value & ".jpg", False, True, l, t, w, h
    
20.       Set rng = .Cells.FindNext(rng)
    
21.     Loop While Not rng Is Nothing And rng.Address <> adr
    
22.   End If
    
23. End With
    
24. Application.ScreenUpdating = True
    
25. End Sub

复制代码