前军教程网

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

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

ActiveSheet.Pictures.Insert(path).Select

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

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

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

ActiveCell.Offset(i, 0).Left
ActiveCell.Offset(i, 0).Top
ActiveCell.Offset(i, 0).rowHeight
ActiveCell.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 i
End 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－