修正后的整行上移和整行下移动代码,兼容WPS专业版
此代码兼容了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专业版](https://zawen.net/post/25.html)
♡♡♡转载请保留上面信息♡♡♡