作者：绿色风
分类：
时间：2022-08-17
浏览：92
楼主
kevinchengcw |
Q: 如何用vba代码根据指定单元格变化内容动态修改图片引用区域？
A: 实现代码如下：- Dim Arr '定义公共变量(这里为了传递固定的图片位置，如果图片是变动的就不要用公共变量)
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Sh As Shape, N&, I&, Str$
- If Not IsArray(Arr) Then '判断公共变量是否初始化，如果没有始化则进行初始化操作
- For Each Sh In ActiveSheet.Shapes '循环活动工作簿中的各个图片
- If Sh.TopLeftCell.Column = 11 Then '如果图片左上角单元格位于K列(如果有不同类型的shape对象,这里可以加上类型判断),则
- If IsEmpty(Arr) Then ReDim Arr(1 To 1) Else ReDim Preserve Arr(1 To UBound(Arr) + 1) '如果数组未初始化则初始化为1个项目的数组,否则保留即有项目情况下项目数加1
- Arr(UBound(Arr)) = Sh.TopLeftCell.Address(0, 0) & ":" & Sh.BottomRightCell.Address(0, 0) '向数组最后一项中写入对应图片的左上角到右下角位置字符串
- End If
- Next Sh
- If IsArray(Arr) And UBound(Arr) > 1 Then '如果公共变量Arr是数组,则项目数大于1,则进行排序操作
- For N = LBound(Arr) To UBound(Arr) - 1 '冒泡排序,根据左上角行号大小从小到大排序
- For I = N + 1 To UBound(Arr)
- If Range(Arr(N)).Row > Range(Arr(I)).Row Then
- Str = Arr(N)
- Arr(N) = Arr(I)
- Arr(I) = Str
- End If
- Next I
- Next N
- End If
- End If
- If Not Intersect(Target, [a1]) Is Nothing Then '如果A1单元格有变化,则
- If IsArray(Arr) Then '如果公共变量已初始化则
- If [a1].Value > 0 And [a1].Value <= UBound(Arr) Then ActiveSheet.DrawingObjects("Image1").Formula = "=" & Arr([a1].Value) '判断A1的值是否处于公共变量数组下标范围中,如果是则修改显示图片的公式引用为对应的图片区域地址
- End If
- End If
- End Sub
由于excel各版本在图形类操作方面代码不尽相同，本例仅在10下测试，如有其他版本用户可进一步测试及修正。
详见附件及素材源帖。
 Book1.rar
|
2楼
纵鹤擒龙水中月 |
学习了 |
3楼
King_Tree |
学习了！谢谢 |
4楼
水星钓鱼 |
感谢分享 |
5楼
老糊涂 |
感谢分享 |
6楼
zhu918918 |
非常感谢 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一