Sub 批量插入图片() '选择图片所在文件夹 Set fd = Application.FileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then lj = fd.SelectedItems(1) Else Exit Sub End If '循环文件夹里 ss = Dir(lj & "\") Do n = n + 1 '新建工作表 Worksheets.Add '插入图片 With ActiveSheet .Shapes.AddPicture lj & "\" & ss, 1, 1, 0, 0, 300, 300 '修改工作表名为图片名,有多少种格式,就可以有多少个replace .Name = Replace(Replace(ss, ".jpg", ""), "其它格式的", "") End With ss = Dir Loop Until ss = "" End Sub