Excel VBA-批量插圖.vba
阿新 • • 發佈:2018-12-17
'大家好,我是笨笨,笨笨的笨,笨笨的笨,謝謝! 'excel 2010 '選中單元格,按其內容,插入圖片 '2014-08-08 Sub inputImg() On Error Resume Next Dim Cell As Range Dim Pics As String Dim ErrCell As String Dim PictruePath As String '圖片路徑 Dim PictrueFormat As String '圖片格式 'PictruePath = "E:\BuildingCity\Working\" '用相對路徑,xls所在目錄下的 images 資料夾 PictruePath = ThisWorkbook.Path & "\images\" PictrueFormat = "png" Selection.ClearComments For Each Cell In Selection Pics = PictruePath & Cell.Value & "." & PictrueFormat If Dir(Pics) = "" Then ErrCell = ErrCell & "" & Cell.Address(0, 0) Else 'Cell.Select '引用 'ActiveSheet.Pictures.Insert(Pics).Select 'Selection.ShapeRange.Height = 150 '插入 ' ActiveSheet.Shapes.AddPicture(Pics, False, True, Range("B" & n).Left, Range("B" & n).Top, 96 * i, 96).Select 'ActiveCell With Cell ActiveSheet.Shapes.AddPicture Filename:=Pics, _ LinkToFile:=True, SaveWithDocument:=True, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height End With '如果插入圖片成功,把字改成白色。 Cell.Font.ColorIndex = 2 '白色的索引 End If Next ' MsgBox "以下單元格沒有圖片哦!" & vbCrLf & ErrCell End Sub