Excel 宏代码：嵌入图片到单元格

Sub EmbedPicture() Dim PicPath As String Dim PicName As String Dim Pic As Picture Dim Cell As Range

' 选择图片文件
With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Clear
    .Filters.Add '图片文件', '*.jpg;*.jpeg;*.png;*.bmp'
    .AllowMultiSelect = False
    If .Show = -1 Then
        PicPath = .SelectedItems(1)
        PicName = Right(PicPath, Len(PicPath) - InStrRev(PicPath, "\" ))
    Else
        Exit Sub
    End If
End With

' 插入图片
Set Pic = ActiveSheet.Pictures.Insert(PicPath)

' 选择插入位置
On Error Resume Next
Set Cell = Application.InputBox('请选择插入位置', '插入图片', Type:=8)
On Error GoTo 0

If Not Cell Is Nothing Then
    ' 调整图片大小和位置
    Pic.Top = Cell.Top + 2
    Pic.Left = Cell.Left + 2
    Pic.Height = Cell.Height - 4
    Pic.Width = Cell.Width - 4
    
    ' 将图片嵌入单元格
    Pic.Select
    Selection.Cut
    Cell.Select
    ActiveSheet.PasteSpecial Format:='Picture (Enhanced Metafile)', Link:=False, DisplayAsIcon:=False
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = Cell.Height
    Selection.ShapeRange.Width = Cell.Width
End If

' 删除插入的图片
Pic.Delete

End Sub