修正后的整行上移和整行下移动代码,兼容WPS专业版

作者:仇朝权 时间:23-09-12 阅读数:336人阅读

此代码兼容了WPS,原代码因为WPS选择方式不一样导致wps无法兼容。

具体效果下载本站置顶的MQCal工程算量体验菜单功能:行上移行下移功能。

Sub RowUP()
'行上移 修正2023年8月9日
    On Error Resume Next
    Dim SelRow&
    SelRow = Selection.Row  '取得选中行,支持wps 默认选中不一样
    If SelRow = S_Ksh Then
        MsgBox "选中行已在开始行顶端。"
        Exit Sub
    ElseIf SelRow < S_Ksh Then
        MsgBox "选中行在开始行外。"
        Exit Sub
    End If
    Selection.EntireRow.Cut
    Selection.Offset(-1).EntireRow.Insert
    If Selection.Rows.Count > 1 Then
        Rows(SelRow - 1 & ":" & SelRow - 2 + Selection.Rows.Count).Select
    Else
        Rows(SelRow - 1).Select
    End If
    'Selection.Offset(-1).Select '//原来的选中行代码,不支持wps
End Sub
Sub RowDOWN()
'行下移 修正2023年8月9日
    On Error Resume Next
    Dim SelRow&
    SelRow = Selection.Row  '取得选中行,支持wps 默认选中不一样
    If SelRow < S_Ksh Then
        MsgBox "选中行在开始行外。"
        Exit Sub
    End If
    If Selection.Rows.Count > 1 Then
        Selection.EntireRow.Cut
        Selection.Offset(Selection.Rows.Count + 1).EntireRow.Insert '选择多行下移的这行,想了很久才搞懂
        Rows(SelRow + 1 & ":" & SelRow + Selection.Rows.Count).Select
        'Selection.Offset(1).Select
    Else
        Selection.EntireRow.Cut
        Selection.Offset(2).EntireRow.Insert
        Rows(SelRow + 1).Select
        'Selection.Offset(1).Select
    End If
End Sub


[本文转自仇朝权随笔_修正后的整行上移和整行下移动代码,兼容WPS专业版](http://www.zawen.net/post/25.html)

分享到:

♡♡♡转载请保留上面信息♡♡♡

发表评论