WPS PPT演示过程中拖拽图片

用ai优化了前辈的版本，前期准备工作参考：

wps演示时图片任意位置拖动_wps使用vba编辑,制作图片拖动效果-CSDN博客

用到的是wps11.1的vba插件，客户端版本12.1亲测可用

优化解决了图片乱飞和拖影的问题，十年前的笔记本电脑无压力

' 模块级变量
Dim InitialX As Single, InitialY As Single   ' 记录鼠标按下时的初始位置
Dim OffsetX As Single, OffsetY As Single     ' 记录图片初始位置与鼠标的偏移量
Dim IsDragging As Boolean                    ' 拖拽状态标识
Dim CurrentSlideIndex As Long                ' 当前幻灯片索引

' 图片鼠标按下事件
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then  ' 仅响应左键
        IsDragging = True
        
        ' 记录初始位置
        InitialX = X
        InitialY = Y
        
        ' 计算偏移量（图片位置与鼠标位置的差值）
        OffsetX = Image1.Left - X
        OffsetY = Image1.Top - Y
        
        ' 记录当前幻灯片索引
        CurrentSlideIndex = SlideShowWindows(1).View.Slide.SlideIndex
        
        ' --- 替换原 ZOrder 方法 ---
        ' 通过遍历形状集合将图片置顶
        Dim sld As Slide
        Set sld = SlideShowWindows(1).View.Slide
        sld.Shapes(Image1.Name).ZOrder msoBringToFront  ' 使用形状名称定位
    End If
End Sub

' 图片鼠标移动事件（已优化防抖动）
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If IsDragging Then
        ' 使用绝对坐标计算（避免累加误差）
        Image1.Left = OffsetX + X
        Image1.Top = OffsetY + Y
        
        ' 智能刷新（降低CPU占用）
        Static LastRefresh As Double
        If Timer - LastRefresh > 0.02 Then  ' 约50FPS刷新率
            ' 使用轻量级刷新替代 GotoSlide
            With SlideShowWindows(1).View
                .AcceleratorsEnabled = False  ' 禁用加速器提升性能
                .DrawLine 0, 0, 0, 0          ' 绘制无效线段触发刷新
                .AcceleratorsEnabled = True
            End With
            LastRefresh = Timer
        End If
    End If
End Sub

' 图片鼠标释放事件
Private Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    IsDragging = False
    
    ' 最终位置校准（解决像素偏移）
    Image1.Left = Round(Image1.Left / 2) * 2
    Image1.Top = Round(Image1.Top / 2) * 2
    
    ' 恢复初始缩放状态
    SlideShowWindows(1).View.GotoSlide CurrentSlideIndex
End Sub

如需多张图片拖动，所有事件代码复制一遍修改图像名称即可(Image1 替换为 Image2）