Vba 在文本中移动单词

我正在尝试创建两个键盘快捷键，使我能够在文本中快速地左右移动选定的单词。所选文本应向左或向右移动一个单词。 这是我想做的

1） 在“这是一棵树”的句子中选择“这是”等词 2） 按ctrl+alt+向右箭头等键 3） 这句话现在读作“这是一棵树” 4） 再次按ctrl-alt+向右箭头键 5） 这句话现在读作“这是一棵树”

这样做的目的是取代剪切/粘贴步骤，使过程更高效、更顺畅。 我没有VB方面的知识，但通过使用Word的宏函数成功地接近了

Sub moveRight()
'moveRight Macro
Selection.Cut
Selection.moveRight Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub

此功能的问题是，粘贴选定单词后，将不再选择它们。因此，再次触发函数（=将文本移动到多个单词）会导致错误（我必须再次选择相关文本）。是否有任何方法可以使所选单词在粘贴后保持选中状态，以便我可以重复触发该函数

---

非常感谢

一种便宜的方法是使用书签。在移动文本之前和之后的某个时间点，分别运行AddBookMark和DeleteBookMark

Public Sub AddBookMark()
    Dim myDocument As Document
    Set myDocument = ActiveDocument

    myDocument.Bookmarks.Add "MySelectedText", Selection
End Sub

Public Sub DeleteBookMark()
    Dim myDocument As Document
    Set myDocument = ActiveDocument

    myDocument.Bookmarks("MySelectedText").Delete
End Sub

Sub moveRight()
    Dim myDocument As Document
    Set myDocument = ActiveDocument

    Selection.Cut
    Selection.moveRight Unit:=wdWord, Count:=1
    Selection.PasteAndFormat (wdFormatOriginalFormatting)

    myDocument.Bookmarks("MySelectedText").Select
End Sub

---

您可能想试试这个解决方案。键盘快捷键应调用以下前两个过程。两者都调用相同的执行子对象，但参数不同

Sub MoveSelectionLeft()
    ' call with keyboard shortcut
    GetSelection True
End Sub

Sub MoveSelectionRight()
    ' call with keyboard shortcut
    GetSelection False
End Sub

Private Sub GetSelection(ByVal ToLeft As Boolean)
    ' 22 Apr 2017

    Dim Rng As Range
    Dim SelTxt As String                    ' selected text (trimmed)
    Dim Sp() As String

    Set Rng = Selection.Range
    With Rng
        SelTxt = Trim(.Text)
        If ToLeft Then
            .MoveStart wdWord, -1
        Else
            .MoveEnd wdWord, 1
        End If
        Sp = Split(Trim(.Text))

        If ToLeft Then
            .Text = SelTxt & " " & Sp(0) & " "
        Else
            .Text = Sp(UBound(Sp)) & " " & SelTxt & " "
        End If
        .Find.Execute SelTxt
        .Select
    End With
End Sub