Q:我原先在工作表中放置了一個圖片,現在我想使用新的圖片來替換該圖片,但是要保持圖片的位置和大小不變,如何使用VBA代碼實現?
A:在VBE中插入一個標準模塊,輸入如下代碼:
SubChangePicLoc()
On Error GoTo ErrHandle
Dim blnFlag As Boolean
Dim shp As Shape
Dim dblTop As Double
Dim dblLeft As Double
Dim dblHeight As Double
Dim dblWidth As Double
Dim FileToOpen As Variant
‘檢查所選取的是形狀還是單元格
blnFlag = False
For Each shp In ActiveSheet.Shapes
If shp.Name = Selection.Name Then
blnFlag = True
Exit For
Else
blnFlag = False
End If
Next shp
ErrHandle:
On Error GoTo endHandle
If blnFlag = True Then
With Selection.ShapeRange
‘保存所選圖片的屬性
dblTop = .Top
dblLeft = .Left
dblHeight = .Height
dblWidth = .Width
End With
‘刪除所選圖片
Selection.Copy
Selection.Delete
‘插入新圖片
FileToOpen =Application.GetOpenFilename
If FileToOpen <> False Then
ActiveSheet.Pictures.Insert(FileToOpen).Select
Else
MsgBox “沒有選擇圖片文件!”
ActiveSheet.Paste
End If
‘將原圖片屬性應用于新圖片
With Selection.ShapeRange
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With
Else
MsgBox “請選擇圖片,不要選擇單元格區域.”
End If
endHandle:
End Sub
首先選取工作表中要替換的圖片,然后運行代碼,效果如下所示。