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【一键整理图片（上）】