本文总共3295个字,阅读需11分钟,全文加载时间:2.377s,本站综合其他专栏收录该内容! 字体大小:

文章导读:Excel中插入图片时,图片位置可以对齐到指定单元格的左上角,图片大小可以调整。 在VBA中,可以用以下代码来插入并选中图片: ActiveSheet.Pictures.Insert(path).Select 其有4个属性可以调整图片的对齐和大小调整……各位看官请向下阅读:

Excel中插入图片时,图片位置可以对齐到指定单元格的左上角,图片大小可以调整。

在VBA中,可以用以下代码来插入并选中图片:

ActiveSheet.Pictures.Insert(path).Select

其有4个属性可以调整图片的对齐和大小调整:

Selection.Left ' 可设置图片的对齐位置Selection.TopSelection.Height '可设置图片的显示大小Selection.Width

对于每一个单元格,可以获取其相对于左上角的坐标位置和行高、列宽:

ActiveCell.Offset(i, 0).LeftActiveCell.Offset(i, 0).TopActiveCell.Offset(i, 0).rowHeightActiveCell.Offset(i, 0).Width

结合以上内容,并可以插入指定图片到指定单元格并精确对齐了:

Sub 从指定文件夹插入指定图片并对齐到单元格() Dim path0 As String path0 = "F:\Website\country\2020Olym\" '需要插入的图片放置的文件夹的路径 Dim fileName As String Dim ext As String ' 扩展名,也可以放到工作表中的某一列 ext = ".png" Dim rowPadding As Long ' 图片所在行上下的边距,单位px rowPadding = 4 Dim picWidth As Long ' 图片宽,单位px picWidth = 56 Dim picHeight As Long ' 图片高,单位px,36*56为中等显示缩略图的尺寸 picHeight = 36 Dim firstPicRow As Long, firstPicCol As Long '指定需要插入的图片所在的列,和首行 firstPicCol = 3 firstPicRow = 2 Cells(firstPicRow, firstPicCol).Activate ' 以激活的单元格为基准(第一张图片插入位置) Cells.rowHeight = (picHeight + rowPadding * 2) * 0.6 ' 行高 = 像素*0.6 (英寸 = 72像素) Columns(3).ColumnWidth = picWidth * 0.097 ' 列宽 = 像素*0.097 (宋体11) Dim fileNameCol As Long fileNameCol = 1 ' 文件名所在的列 Dim offsetCols As Long ' 插入图片的列相对于文件名所在列的偏移列数 offsetCols = firstPicCol - fileNameCol 'On Error Resume Next '程序出错时继续执行下一步 Dim pics As Long ' 需要插入的文件数量,由下列指定的列来统计 pics = Range("A" & Cells.Rows.Count()).End(xlUp).Row - 2 For i = 0 To pics fileName = ActiveCell.Offset(i, -offsetCols).Value path = path0 + fileName + ext Debug.Print path ActiveSheet.Pictures.Insert(path).Select Selection.Left = ActiveCell.Offset(i, 0).Left '设置插入的图片的左边距 Selection.Top = ActiveCell.Offset(i, 0).Top + rowPadding '设置插入的图片的上边距+单元格边距 Selection.ShapeRange.LockAspectRatio = msoFalse '取消图片的"锁定纵横比",调整行高时图片会相应变化 Selection.Height = ActiveCell.Offset(i, 0).rowHeight - rowPadding * 2 '设置插入的图片的高度 Selection.Width = ActiveCell.Offset(i, 0).Width '设置插入的图片的的宽度 'Selection.Placement = xlMoveAndSize '让图片的位置与大小随单元格变化而变化 Next iEnd Sub

效果如下:

也可以从文件夹中插入全部图片到Excel的工作表:

Sub 从文件夹中插入全部图片到指定列() ' 先按需要插入的图片大小设置好插入列的行高和列宽 ' 插入的第一列是文件名,第二列是图片 Cells(2, 1).Activate ' 默认从第二行第一列开始插入文件名,第二列插入图片 Dim picFileName As String, n As Long, Paths, ext, folder As FileDialog '定义变量 On Error Resume Next '程序出错时继续执行下一步 With Application.FileDialog(msoFileDialogFolderPicker) '产生一个浏览窗口 .AllowMultiSelect = False '不允许多选 If .Show = True Then Paths = .SelectedItems(1) '如果未取消则记录文件夹路径 End With Application.ScreenUpdating = False '关闭屏幕更新,提升速度 ext = Array("\*.jpg", "\*.jpeg", "\*.bmp", "\*.png", "\*.gif") '用数组变量记录五种文件格式 For i = 0 To UBound(ext) - LBound(ext) + 1 '遍历数组中的所有元素,即查找5种格式的文件 picFileName = Dir(Paths & ext(i)) '查找第一个符合条件的文件,取文件名 While Len(picFileName) > 0 '如果文件存在,就继续执行命令 picFileNameNoExt = Mid(picFileName, 1, Len(picFileName) - 4) ActiveCell.Offset(n, 0) = picFileNameNoExt '将文件名称存放在单元格中 '在当前表中插入图片,路径由Paths决定,文件的后缀名由str决定.插入的图片处于选中状态 ActiveSheet.Pictures.Insert(Paths & IIf(Right(t, 1) = "\", "", "\") & picFileName).Select Selection.Left = ActiveCell.Offset(n, 1).Left '设置插入的图片的左边距 Selection.Top = ActiveCell.Offset(n, 1).Top '设置插入的图片的上边距 Selection.ShapeRange.LockAspectRatio = msoFalse '取消图片的"锁定纵横比",调整行高时图片会相应变化 Selection.Height = ActiveCell.Offset(n, 1).rowHeight '设置插入的图片的高度 Selection.Width = ActiveCell.Offset(n, 1).Width '设置插入的图片的的宽度 'Selection.Placement = xlMoveAndSize '让图片的位置与大小随单元格变化而变化 n = n + 1 '记录插入的图片的个数 picFileName = Dir() '查找下一个 Wend Next Application.ScreenUpdating = True '恢复屏幕更新 If i > 0 Then MsgBox "已插入" & n & "个图片!", vbOKOnly, "提示" '提示图片数量End Sub

效果如下:

-End-

以上内容由优质教程资源合作伙伴 “鲸鱼办公” 整理编辑,如果对您有帮助欢迎转发分享!

你可能对这些文章感兴趣:

发表评论

您的电子邮箱地址不会被公开。 必填项已用*标注