一个模具管理的文件，带模具图片。

zjdh

发一个模具管理的文件，带模具图片。
可以方便的添加修改图片。
文件带使用说明。

duwei9981

下载看看，多谢分享。

zhuangjinpin

我看了一下，还不错

kamala_leung

多谢啦。学习下

qiyulel

看看。谢谢LZ

KISS8848

多谢啦学习学习

浅香

先学习啦！下载后学习

yangkd

很好，图片自动插入VBA不懂，特好！
如果有公式的好理解，对我而言。不过
我很喜欢VBA插入图片，能否介绍代码
方便我们菜鸟变通使用。谢谢！！

zjdh

其实这儿关于图片用的VBA特简单，宏分为3部分:

1. Private Sub Image1_Click()   '点击图片放大或缩小图片
   
2.     'N3记录了图片状态(不是理想的办法)
   
3.     If Range("N3") = 1 Then   '若为"1"
   
4.         G = 0.5               '放大为0.5倍(缩小)
   
5.     Else
   
6.         G = 2                 '放大为2倍
   
7.     End If
   
8.     With Sheet1.Shapes("Image1")
   
9.         .ScaleWidth G, msoFalse, msoScaleFromTopRight     '调整宽度
   
10.         .ScaleHeight G, msoFalse, msoScaleFromBottomRight '调整高度
    
11.     End With
    
12.     Range("N3") = -Range("N3")  '状态记录反转
    
13. End Sub
    
14. 
    
15. Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)    '双击调入或更改图片
    
16.     On Error Resume Next  '若出现错误则运行下一条
    
17.     FileToOpen = Application.GetOpenFilename("上传照片(*.jpg),*.jpg")    '打开文件选择对话框
    
18.     If FileToOpen <> False Then   '如果选择了图片文件
    
19.         Kill ThisWorkbook.Path & "\图片" & Range("L2") & ".jpg"        '删除以L2内容为名称的图片
    
20.          Dim fso As New FileSystemObject
    
21.         fso.CopyFile FileToOpen, ThisWorkbook.Path & "\图片"        '将图片文件复制到"图片"目录下
    
22.         OldName = ThisWorkbook.Path & "\图片" & Mid(FileToOpen, InStrRev(FileToOpen, "") + 1, Len(FileToOpen))
    
23.                '获取原文件名称及路径
    
24.         NewName = ThisWorkbook.Path & "\图片" & Range("L2") & ".jpg"        '获取L2为名称的图片名称及路径
    
25.         Name OldName As NewName  '更改图片文件名称
    
26.         Err.Clear  '若出现错误则清除信息
    
27.     End If
    
28.     Sheet1.Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\图片" & Range("L2") & ".jpg")    '工作表调入新图片
    
29. End Sub
    
30. 
    
31. Private Sub Worksheet_Change(ByVal Target As Range)     '自动调入图片
    
32.     On Error Resume Next
    
33.     If Target.Address = "$L$2" Then  '若L2内容被修改
    
34.      With Sheet1
    
35.             If Dir(ThisWorkbook.Path & "\图片" & Range("L2") & ".jpg") <> "" Then   '若存在对应图片
    
36.                 .Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\图片" & Range("L2") & ".jpg")     '调入图片
    
37.           ElseIf Dir(ThisWorkbook.Path & "\图片" & Range("L2") & ".jpg") = "" Then  '若没有对应图片
    
38.                 .Image1.Picture = LoadPicture(ThisWorkbook.Path & "\图片\没有图片" & ".jpg")    '调用"没有图片.jpg"
    
39.             End If
    
40.         End With
    
41.     End If
    
42. End Sub
    

复制代码

yangkd

我不懂VBA刚刚试试放在我的表单里，相应单元格替换我要的怎么没有反应，
请老师看看。谢谢费心了，是否还要什么操作和代码变更或者定义什么啊。
人事表图片.rar (42.34 KB, 下载次数: 51)

2011-8-10 11:49 上传

点击文件名下载附件

[ 本帖最后由 yangkd 于 2011-8-10 11:56 编辑 ]