龙空技术网

VBA|从指定文件夹插入指定图片并精确对齐到指定单元格

小智雅汇 611

前言:

如今大家对“设置图片在div中居中”大约比较注重,我们都想要分析一些“设置图片在div中居中”的相关文章。那么小编在网络上网罗了一些关于“设置图片在div中居中””的相关资讯,希望大家能喜欢,各位老铁们快快来学习一下吧!

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-

标签: #设置图片在div中居中 #图片左边距怎么设置