因为常常有图片是冒出来topleftcell一点点的，所以采取了图片往右下角移动1/3的策略。
d = IIf(d < 1, IIf(d < 0.618, 0.618 / d, 1), 0.9 / d) '最小比例为0.618 ，0.618和0.9之间的话保持图片原状，否则缩放到0.9。
这里把图片的长宽进行调整，如果图片宽高大于单元格一倍，调整为0.9倍，如果图片太小小于0.618，则把图片放大到0.618倍单元格。

ActiveSheet.AutoFilterMode = False '取消筛选
For I = 1 To ActiveSheet.Shapes.Count
　With ActiveSheet.Shapes(I)
　　If .Type <> 12 And .Type <> 8 And .Type <> 9 Then '排除按钮控件,宽高不为0 (排除直线9)
　　　If .Height * .Width = 0 Then .Height = 100: .Width = 100 '把隐藏的图片显示出来先
　　　If .Rotation <> 0 Then .Rotation = Round(.Rotation / 90, 0) * 90 '旋转值取整
　　　wi = .Width '图片宽高调整
　　　hi = .Height
　　　kg = 0 '如果 宽高 不互换则为 0
　　　If Round(.Rotation / 90, 0) = 1 Or Round(.Rotation / 90, 0) = 3 Then '如果图片旋转约为90度或者270°宽高互换，保证wi为横向宽度，hi为竖向宽度
　　　　wi = hi
　　　　hi = .Width
　　　　kg = 1 '如果 宽高 互换则为 1
　　　End If
　　　.Top = .Top + hi / 3: .Left = .Left + wi / 3 '图片往右下方移动
　　　Set a = .TopLeftCell.MergeArea 'a为图片左侧定点的合并区域
　　　.ScaleHeight 1, True: .ScaleWidth 1, True '恢复原始长宽
　　　hi = IIf(kg = 0, .Height / .Width, .Width / .Height) * wi '保持原始长宽比，重新设置竖向高
d = IIf(hi / a.Height > wi / a.Width, hi / a.Height, wi / a.Width) '图片尺寸与单元格尺寸之比的较大者
　　　d = IIf(d < 1, IIf(d < 0.618, 0.618 / d, 1), 0.9 / d) '最小比例为0.618 ，0.618和0.9之间的话保持图片原状，否则缩放到0.9。
　　　.LockAspectRatio = msoFalse '取消长宽比 锁定
　　　.Height = IIf(kg = 0, hi, wi) * d: .Width = IIf(kg = 0, wi, hi) * d '缩放图片
　　　.LockAspectRatio = msoTrue
　　　.Top = a.Top + (a.Height - IIf(kg = 0, hi, wi) * d) / 2 '判断宽高是否互换
　　　.Left = a.Left + (a.Width - IIf(kg = 0, wi, hi) * d) / 2 '判断宽高是否互换
　　　.Placement = xlMoveAndSize ' xlMove
　　End If
　End With
Next
End Sub

Sub 三分排图()
ActiveSheet.AutoFilterMode = False '取消筛选
For I = 1 To ActiveSheet.Shapes.Count
　With ActiveSheet.Shapes(I)
　　If .Type <> 12 And .Type <> 8 And .Type <> 9 Then '排除按钮控件,宽高不为0 (排除直线9)
　　　If .Height * .Width = 0 Then .Height = 100: .Width = 100 '把隐藏的图片显示出来先
　　　If .Rotation <> 0 Then .Rotation = Round(.Rotation / 90, 0) * 90 '旋转值取整
　　　wi = .Width '图片宽高调整
　　　hi = .Height
　　　kg = 0 '如果 宽高 不互换则为 0
　　　If Round(.Rotation / 90, 0) = 1 Or Round(.Rotation / 90, 0) = 3 Then '如果图片旋转约为90度或者270°宽高互换，保证wi为横向宽度，hi为竖向宽度
　　　　wi = hi
　　　　hi = .Width
　　　　kg = 1 '如果 宽高 互换则为 1
　　　End If
　　　.Top = .Top + hi / 3: .Left = .Left + wi / 3 '图片往右下方移动
　　　Set a = .TopLeftCell.MergeArea 'a为图片左侧定点的合并区域
　　　If .Type <> 6 Then .ScaleHeight 1, True: .ScaleWidth 1, True '恢复原始长宽.因为有时候有组合图片type=6，ScaleHeight 1 报错
　　　hi = IIf(kg = 0, .Height / .Width, .Width / .Height) * wi '保持原始长宽比，重新设置竖向高
d = IIf(hi / a.Height > wi / a.Width, hi / a.Height, wi / a.Width) '图片尺寸与单元格尺寸之比的较大者
　　　d = IIf(d < 1, IIf(d < 0.618, 0.618 / d, 1), 0.9 / d) '最小比例为0.618 ，0.618和0.9之间的话保持图片原状，否则缩放到0.9。
　　　.LockAspectRatio = msoFalse '取消长宽比 锁定
　　　.Height = IIf(kg = 0, hi, wi) * d: .Width = IIf(kg = 0, wi, hi) * d '缩放图片
　　　.LockAspectRatio = msoTrue
　　　.Top = a.Top + (a.Height - IIf(kg = 0, hi, wi) * d) / 2 '判断宽高是否互换
　　　.Left = a.Left + (a.Width - IIf(kg = 0, wi, hi) * d) / 2 '判断宽高是否互换
　　　.Placement = xlMoveAndSize ' xlMove
　　End If
　End With
Next
End Sub