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