[已解决]返回指定图片代码修改

alxixi520

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    图片路径 = ThisWorkbook.Path & "\" & "照片\"
    Image1.Picture = LoadPicture(图片路径 & Range("J3") & ".jpg")
    Label1.Caption = Range("J3").Value
End Sub

我想实现当图片路径内没有与J3同名的图片，图片直接返回”ad.jpg"的图片。

最佳答案

月排行榜 / 总排行榜

su45

2016-8-4 21:17

改用这段代码吧：

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2. If T.Address = "$J$3" Then
   
3.     On Error Resume Next
   
4.     ActiveSheet.Unprotect (Password = "")
   
5.     mypath = ThisWorkbook.Path & "" & "照片"
   
6.     myfile = Dir(mypath & Range("J3") & ".jpg") '获取文件
   
7.     If myfile = "" Then '若文件不存在，myfile的值就是空的
   
8.         myfile = Dir(mypath & "ad.jpg")
   
9.     End If
   
10.     Set Rng = Range("J4:K8")
    
11.     For Each shp In ActiveSheet.Shapes
    
12.         If shp.Left = Rng.Left And shp.Top = Rng.Top Then shp.Delete
    
13.     Next
    
14.     ActiveSheet.Shapes.AddShape(msoShapeRectangle, Rng.Left, Rng.Top, Rng.Width, Rng.Height).Select
    
15.     Selection.ShapeRange.Fill.UserPicture mypath & myfile
    
16. End If
    
17. ActiveSheet.Protect (Password = "")
    
18. Range("C4").Select
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

su45

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. On Error Resume Next
   
3. 图片路径 = ThisWorkbook.Path & "" & "照片"
   
4. myfile = Dir(图片路径 & Range("J3") & ".jpg") '获取文件
   
5. If myfile <> "" Then '若文件不存在，myfile的值就是空的
   
6.     Image1.Picture = LoadPicture(myfile)
   
7.     Label1.Caption = Range("J3").Value
   
8. Else
   
9.     Image1.Picture = LoadPicture(图片路径 & ad.jpg)
   
10.     Label1.Caption = Range("J3").Value
    
11. End If
    
12. End Sub
    

复制代码

alxixi520

su45 发表于 2016-8-3 10:28

您好！由于我是个菜鸟，您发的我不知道怎么弄进去，麻烦您帮试试呗。当“照片”文件夹内没有与J3同名的照片，图片直接返回等于"ad.jpg"
谢谢！

su45

给你修改了下，你试试：

员工登记表1.zip (26.54 KB, 下载次数: 8)

2016-8-4 11:05 上传

点击文件名下载附件

alxixi520

su45 发表于 2016-8-4 11:05
给你修改了下，你试试：

谢谢您的帮助，我测试过基本上能达到我需要的目的了。但是我设置了允许编辑J3单元格，然后设置表格保护后，图片就不能变了。不知道是什么原因。麻烦您抽空再帮我修改下，可以吗？

su45

改用这段代码吧：

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2. If T.Address = "$J$3" Then
   
3.     On Error Resume Next
   
4.     ActiveSheet.Unprotect (Password = "")
   
5.     mypath = ThisWorkbook.Path & "" & "照片"
   
6.     myfile = Dir(mypath & Range("J3") & ".jpg") '获取文件
   
7.     If myfile = "" Then '若文件不存在，myfile的值就是空的
   
8.         myfile = Dir(mypath & "ad.jpg")
   
9.     End If
   
10.     Set Rng = Range("J4:K8")
    
11.     For Each shp In ActiveSheet.Shapes
    
12.         If shp.Left = Rng.Left And shp.Top = Rng.Top Then shp.Delete
    
13.     Next
    
14.     ActiveSheet.Shapes.AddShape(msoShapeRectangle, Rng.Left, Rng.Top, Rng.Width, Rng.Height).Select
    
15.     Selection.ShapeRange.Fill.UserPicture mypath & myfile
    
16. End If
    
17. ActiveSheet.Protect (Password = "")
    
18. Range("C4").Select
    
19. End Sub
    

复制代码