我正在尝试创建以下模板:
用户在“数据输入”工作表中创建一个表格,其中列出以下内容:
1.文件路径,即:P:\手机摄像头转储\20121224_111617.jpg
1.图片在“PICS”工作表中放置的范围。
列表完成后,用户执行并将图像放置在“PICS”工作表上指定的范围内,并动态调整大小。
目前,该范围的宽度为624px,高度为374px,但理想情况下,我希望图像在宽度和高度变化时动态调整大小(纵横比不锁定)。
我已经使用了以下代码作为基础,但正在努力解决如何合并单元格范围而不是静态行更新:
Sub InsertSeveralImages()
Dim pic_Path As String 'File path of the picture
Dim cl As Range, Rng As Range
Dim WS_Templte As Worksheet
Set WS_Templte = Worksheets("PICS")
Set Rng = Worksheets("Data Entry").Range("C13:C42")
pastingRow = 2
For Each cl In Rng
pic_Path = cl.Value
Set InsertingPicture = WS_Templte.Pictures.Insert(pic_Path)
'Setting of the picture
With InsertingPicture
.ShapeRange.LockAspectRatio = msoTrue
.Height = 100
.Top = WS_Templte.Rows(pastingRow).Top
.Left = WS_Templte.Columns(3).Left
End With
pastingRow = pastingRow + 5
Next cl
Set myPicture = Nothing
WS_Templte.Activate
End Sub
有什么想法吗?
1条答案
按热度按时间brqmpdu11#
我想出来了。下面是代码,以防有人想用:
公共子插件图片()
尺寸vntFilePath作为变量尺寸rngFilePath作为范围尺寸vntPastePath作为变量尺寸rngPastePath作为范围尺寸lng计数器作为长度尺寸pic作为图片集WS_Templte =工作表("PICS")
出错时使用此工作簿转到ErrHandler. Sheets("PICS")'〈--相应地更改工作表名称
'设置包含行号的第一个单元格Set rngFilePath =. Range("BJ7")vntFilePath = rngFilePath. Value
'设置包含粘贴区域的第一个单元格Set rngPastePath =. Range("BK7")vntPastePath = rngPastePath. Value
结束于
MsgBox lngCounter &"图片已插入",vb信息
退出过程:设置rngFilePath =无设置pic =无退出子对象
错误处理程序:MsgBox错误描述,vbExclamation恢复退出过程结束子项