Excel动态引用图片或照片的三种方法 | 您所在的位置:网站首页 › excel怎么批量导出图片并保存到桌面 › Excel动态引用图片或照片的三种方法 |
一、将公式定义成名称进行引用 1、设计一个表格“名单”,保存各项信息,包括照片,如下: 2、切换到公式选项卡,点击名称管理器,如下: 3、新建一个名称“照片”,在“照片”的引用位置输入公式如下: =INDEX(名单!$L$2:$L$4,MATCH(员工查询表!$B$4,名单!$A$2:$A$4,0)) 或者 =OFFSET(名单!$A$1,MATCH(员工查询表!$B$4,名单!$A$2:$A$4,0),11) 说明:不能使用vlookup公式,这里必须使用绝对引用$符号,不然定义的名称的引用位置会变化。若图片需要根据单元格中填写的行号变动,可以在MATCH第一个参数中使用INDIRECT或OFFSET公式,如:=INDEX(名单!$L$2:$L$4,MATCH(INDIRECT("名单!$A$"&名单!$J$6),名单!$A$2:$A$4,0))。 4、复制一张图片到Excel的单元格中,选中该图片,将编辑栏的公式编辑为“=照片”,这样,只要修改B4单元格中数据,就会显示相应照片,如下: 说明:此方法引用的照片,只能根据“员工查询表!$B$4”中的内容进行改变,其他所有引用此名称的照片都是如此。 5、图片的裁剪、填充、线条颜色等属性可以设置图片,如下: 二、使用VBA实现上面图片名称的公式添加 Sub Excel中添加图片引用的名称() '原表有有编号和编号所在行的图片,此代码实现新表根据原表编号动态显示图片 '新表每行插入空白图片,第二次为图片设置图片引用名称 ' "=INDEX(名单!R2C12:R4C12,MATCH(名单!R6C11,名单!R2C1:R4C1,0))" On Error Resume Next Dim picName As String picName = "图片" '公式名称 Dim strPicRng As String, strPicId As String, strPicIdRng As String strPicIdRng = "名单!R2C1:R4C1" '原图片根据编号变化,编号所在列 strPicRng = "名单!R2C12:R4C12" '原图片所在列 strPicId = "Sheet3!R" '新表中的编号所在单元格 Dim i As Integer Dim startRow As Integer, endRow As Integer Dim oldPic As Shape Dim newPicColNum As Integer, newPicIdCol As Integer newPicIdCol = 1 '新图片编号所在列号 newPicColNum = 2 '新图片所在列号 startRow = 2 '新图片开始行号 endRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row '新表中图片结束行号 For i = startRow To endRow '添加公式名称,在新的列中添加图片,并将图片的表达式设置为名称引用 '定义图片名称 ActiveWorkbook.Names.Add Name:=picName & i, RefersToR1C1:="=INDEX(" & _ strPicRng & ",MATCH(" & strPicId & i & "C" & newPicIdCol & "," & strPicIdRng & ",0))" Set oldPic = getCellShape(ActiveSheet.Cells(i, newPicColNum)) '获取单元格区域照片 If oldPic Is Nothing Then '单元格区域无照片 '添加新图片 ActiveSheet.Cells(i, newPicColNum).CopyPicture ActiveSheet.Cells(i, newPicColNum).Select ActiveSheet.Paste Selection.ShapeRange.Name = "pic" & i ' ActiveSheet.Shapes.Range(Array("pic" & i)).Select Selection.Formula = "=" & picName & i '图片名称对应公式必须有图片才行 Else '有照片就设置表达式为引用名称 oldPic.Name = "pic" & i oldPic.Select Selection.Formula = "=" & picName & i '图片名称对应公式必须有图片才行 End If Next End Sub Function getCellShape(cellRng As Range) As Shape '获取当前Sheet表格cellRng单元格区域上的图片 Dim picShape As Shape For Each picShape In ActiveSheet.Shapes If picShape.Type = msoPicture Then If Not Application.Intersect(picShape.TopLeftCell, cellRng) Is Nothing Then Set getCellShape = picShape Exit Function End If End If Next Set getCellShape = Nothing End Function 三、vba根据新表编号从旧表复制图片到新表列 Sub vba将Excel原表编号对应行图片复制到新表() Dim btnShape As Shape For Each btnShape In ActiveSheet.Shapes If Not btnShape.Name Like "Button*" Then btnShape.Delete Next Dim startRow As Integer, endRow As Integer, i As Integer startRow = 2: endRow = ActiveSheet.[A65535].End(xlUp).Row Dim findRng As Range Dim rngTop As Variant, rngHeight As Variant Dim picShape As Shape For i = startRow To endRow With Sheets("名单") Set findRng = .Range("A:A").Find(ActiveSheet.Range("A" & i), lookat:=xlWhole) If Not findRng Is Nothing Then rngTop = findRng.Top rngHeight = findRng.Height For Each picShape In .Shapes If picShape.Top > rngTop - 5 And picShape.Top + picShape.Height < rngTop + rngHeight + 5 Then picShape.Copy ActiveSheet.Range("C" & i).Select ActiveSheet.Paste End If Next End If End With Next End Sub 欢迎交流分享,联系qq:329876601 |
CopyRight 2018-2019 实验室设备网 版权所有 |