Sub 插入图片() Dim filenames As String  Dim filefilter1 As String  filefilter1 = ("所有图片文件（*.jpg;*.bmp;*.png;*.gif）,*.jpg;*.bmp;*.png;*.gif")    '所有图片文件后面的括号为中文括号 filenames = Application.GetOpenFilename(filefilter1, , "请选择一个图片文件", , MultiSelect:=False)  '没有选中文件时，做容错处理 If filenames = "False" Then  Exit Sub  End If  '插入图片到指定的单元格 Sheet1.Pictures.Insert(filenames).Select  '图片自适应单元格大小 On Error Resume Next  Dim picW As Single, picH As Single  Dim cellW As Single, cellH As Single  Dim rtoW As Single, rtoH As Single  cellW = ActiveCell.Width  cellH = ActiveCell.Height  picW = Selection.ShapeRange.Width  picH = Selection.ShapeRange.Height  rtoW = cellW / picW * 0.95  rtoH = cellH / picH * 0.95  If rtoW < rtoH Then      Selection.ShapeRange.ScaleWidth rtoW, msoFalse, msoScaleFromTopLeft  Else      Selection.ShapeRange.ScaleHeight rtoH, msoFalse, msoScaleFromTopLeft  End If  picW = Selection.ShapeRange.Width  picH = Selection.ShapeRange.Height  Selection.ShapeRange.IncrementLeft (cellW - picW) / 2  Selection.ShapeRange.IncrementTop (cellH - picH) / 2  End Sub