Sub test() Dim rg As Range, shp As Shape Rem --------------------------------------------------- Rem 清除圖形對象 For Each shp In ActiveSheet.Shapes shp.Delete Next Rem --------------------------------------------------- Rem 按名稱插入圖片 Rem 下行代碼,根據A列開始循環處理 For I = 2 To Cells(Rows.Count, "A").End(3).Row Set rg = Cells(I, "B") Rem 下面代碼,添加矩形 ActiveSheet.Shapes.AddShape(msoShapeRectangle, rg.Left, rg.Top, rg.Width, rg.Height).Select Rem 下面代碼,在矩形內部用圖片填充 Selection.ShapeRange.Fill.UserPicture rg.Offset(0, -1).Value Next End Sub
按ALT+F8運行該宏