批量导入照片到EXCEL中

Private Sub Worksheet_Change(ByVal Target As Range)

 On Error Resume Next

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".jpg").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".jpeg").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".gif").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".jpe").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".BMP").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".BMP").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".BMP").Select  'Insert Pictures"

  

ActiveSheet.Pictures.Insert("C:\\temp\\" & Target.Text & ".BMP").Select  'Insert Pictures"

  

Selection.Name = Target.Text

 'Picture name

  

Selection.ShapeRange.LockAspectRatio = msoFalse '

  

Selection.ShapeRange.Height = Target.Height  'H

  

Selection.ShapeRange.Width = Target.Width  'W

  

Selection.ShapeRange.Top = Target.Top  'Top

  

Selection.ShapeRange.Left = Target.Left  'Left

 End Sub

 

有规律，用宏做个循环就可以，基本代码为：

ActiveSheet.Shapes.AddPicture"D:\My Documents\My Pictures\untitled.bmp", False, True, Range("D5").Left, Range("D5").Top, 50, 50

要么你的Excel表格里有照片名称（路径和后缀名都一样），要么给出路径和后缀名，都可以实现。