（純代碼）Excel VBA-WE012【一鍵整理圖片（上）】

Sub arrPIC()
For Each shp In ActiveSheet.Shapes
 With shp
 If .Type = 13 Then
 If .Rotation = 90 Or .Rotation = 270 Or .Rotation = 180 Then
 x = .TopLeftCell.Left
 y = .TopLeftCell.Top
 .ScaleHeight 1, True
 .ScaleWidth 1, True
 .CopyPicture 'WPS會根據縮放的圖片進行Copy
 ActiveSheet.Paste
 Selection.Left = x + 1
 Selection.Top = y + 1
 .Delete
 End If
 End If
 End With
Next
For Each shp In ActiveSheet.Shapes
 With shp
 If .Type = 13 Then
 .LockAspectRatio = msofource
 r = .TopLeftCell.Row
 c = .TopLeftCell.Column
 Select Case r
 Case 1 To 4
 .Width = 205
 .Height = 160
 .Top = .TopLeftCell.Top + 4
 .Left = .TopLeftCell.Left + 4
 .Placement = xlFreeFloating '大小位置均固定
 Case 5 To 8
 .Width = 152
 .Height = 107
 .Top = .TopLeftCell.Top + 4
 .Left = .TopLeftCell.Left + 4
 .Placement = xlMoveAndSize '大小位置隨單元格
 End Select
 End If
 End With
Next
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\傳說中的藍白小鎮.JPG").Select
With Selection
 .ShapeRange.LockAspectRatio = msoFalse
 .Top = [B9:E12].Top + 4
 .Left = [B9:E12].Left + 4
 .Width = [B9:E12].Width - 8
 .Height = [B9:E12].Height - 8
End With
End Sub

代碼分析，敬請查閱：

零基礎學Excel VBA-WE012【一鍵整理圖片（上）】