* * *
It moves marked pieces of texts to before the next period, colon , ?, !, carriage return or new line in a document. It is most useful for swapping pieces of text within sentences. In other words, mark a few words in a sentence, call this macro, and it will automatically move the marked words to the end of the sentence.
There may be some bugs in it and it may not work under all circumstances, but it shouldn't be too bad.
Sub DragDrop_3e()
'
' DragDrop_3e Makro
'
' Piece of text is marked when this test macro is called
'
' MOD 080802: Even if 1st char in marked text is not a capital,
' change 1st char in other text to lowercase
'
' MOD 080802A: Delete "," if at end of marked text
'
'
' Save 1st char from marked text
FirstMarkedChar = Selection.Characters.Item(1)
' Save range boundaries for future use
MarkingStart = Selection.Range.start
MarkingEnd = Selection.Range.End
' Save marked text and length of marked text
MarkedText = Selection.Text
LengthOfMarkedText = Selection.Characters.Count
' For use in DragDrop macro. At beginning of sentence change
' first letter to capital letter and make sure 1st letter
' in 2nd part of sentence is lower case
'
' Check to see if marked text starts at the beginning
' of the sentence.
'
' 1st check
' 1st character in marked text is not a lower case letter (a-z)
'
' Check that 1st char in marked text is a capital letter [A-Z]
' ASCII codes: a = 97, z = 122, A = 65, Z = 90
If Asc(FirstMarkedChar) > 64 And Asc(FirstMarkedChar) < 91 Then
' Char is a capital letter
DontConvert = False
' Change 1st char in marked text to lowercase [a-z]
FirstMarkedCharInt = Asc(FirstMarkedChar)
NewFirstMarkedCharInt = FirstMarkedCharInt + 32
' Form Marking less 1st char
Set MarkingLess1stChar = ActiveDocument.Range(start:=MarkingStart + 1, End:=MarkingEnd)
' Create new marked text
NewMarkedText = Chr(32) + Chr(NewFirstMarkedCharInt) + MarkingLess1stChar
Else
' First char in marked text is lowercase
DontConvert = False
' Copy marked text string to new marked text string
' for consistency and insert space before new marked string
NewMarkedText = MarkedText
NewMarkedText = Chr(32) + NewMarkedText
End If
' Copy marked text to buffer
Selection.Copy
' Set bookmark "OrigText" at marked text
ActiveDocument.Bookmarks.Add Name:="OrigText"
' Extend marking by one char backwards in document
Selection.MoveStart Unit:=wdCharacter, Count:=-1
' Save extended marking 1
ExtendMarking1 = Selection.Text
' Extend marking by another char backwards in document
Selection.MoveStart Unit:=wdCharacter, Count:=-1
' Save extended marking 2
ExtendMarking2 = Selection.Text
' Go to bookmark "OrigText" again
ActiveDocument.Bookmarks("OrigText").Select
' Cut the marked piece of text
Selection.Cut
' Save current cursor position
' Set bookmark at current position - at marked text
ActiveDocument.Bookmarks.Add Name:="temp"
' Look for carriage return char (13)
a = Selection.MoveUntil(Cset:=vbCr)
' Set bookmark at this position
ActiveDocument.Bookmarks.Add Name:="CR"
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for vertical tab char (11)
b = Selection.MoveUntil(Cset:=vbVerticalTab)
' Set bookmark at this position
ActiveDocument.Bookmarks.Add Name:="VertTab"
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for period not in number (like ".2")
Selection.Find.ClearFormatting
With Selection.Find
.Text = ".[!0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Good period found?
If Selection.Find.Execute = True Then
' Yes
' Period found and not in number
' Insert some never used char (e.g î) to establish position
' of this period and delete char again
Selection.InsertBefore "î"
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for temp char
F = Selection.MoveUntil(Cset:="î")
'Remove temporary char again
Selection.Delete Unit:=wdCharacter, Count:=1
' Set bookmark "Period" at this position
ActiveDocument.Bookmarks.Add Name:="Period"
End If
' Reset MitMusterKennung
Selection.Find.ClearFormatting
With Selection.Find
.Text = ".[!0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for : ! or ? char
c = Selection.MoveUntil(Cset:=":!?")
' Set bookmark at this position
ActiveDocument.Bookmarks.Add Name:="LikePeriod"
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for closing bracket ")" char
d = Selection.MoveUntil(Cset:=")")
' Set bookmark at this position
ActiveDocument.Bookmarks.Add Name:="CloseBracket"
' Check if ")" found and is before other three char types ????
If d = 0 Then
' ")" not found, handle other three chars
GoTo Branch4:
End If
' ")" found, check that marked text is inside brackets
'
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Look for opening bracket "(" char
e = Selection.MoveUntil(Cset:="(")
' Set bookmark at this position
ActiveDocument.Bookmarks.Add Name:="OpenBracket"
' Check if "(" lies before ")"
If e < d And e <> 0 Then
' Yes, then marked text not inside brackets
' Handle other three chars
GoTo Branch4:
End If
' Check if ")" lies before "CR", VertTab", "LikePeriod"
' If d < a And d < b And d < c Then
' Yes
ActiveDocument.Bookmarks("CloseBracket").Select
' Goto ")" position to enter marked text
' Move marked text
DontConvert = True
GoTo Branch2:
' End If
Branch4:
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Establish which of the searched chars are the nearest
'
' a = "CR" b = "VertTab" c = "LikePeriod"
' d = ")" e = "(" f = "Period"
'
' 1st step, compare c "LikePeriod" & f "Period"
If (c = 0) And (F <> 0) Then
Resper = F
GoTo PerBranch:
End If
If (c <> 0) And (F = 0) Then
Resper = c
GoTo PerBranch:
End If
If (c < F) Then
Resper = c
Else
Resper = F
End If
PerBranch:
If (a = 0) And (b <> 0) Then
Res1 = b
GoTo Branch1:
End If
If (a <> 0) And (b = 0) Then
Res1 = a
GoTo Branch1:
End If
If (a < b) Then
Res1 = a
Else
Res1 = b
End If
Branch1:
If (Res1 = 0) And (Resper <> 0) Then
Res2 = Resper
GoTo Branch3:
End If
If (Res1 <> 0) And (Resper = 0) Then
Res2 = Res1
GoTo Branch3:
End If
If (Res1 < Resper) Then
Res2 = Res1
Else
Res2 = Resper
End If
Branch3:
' ASCII codes: a = 97, z = 122, A = 65, Z = 90
' If Asc(FirstMarkedChar) > 97 And Asc(FirstMarkedChar) < 122 Then
' Char is lower case
' DontConvert = True
' GoTo NoConversion:
' End If
' Char not lower case
' Check that (char in document before 1st char in marked text
' is space and next previous char is a period) or
' (char in document before 1st char in marked text is
' "CR" or "VertTab")
' or
' (this is beginning of document)?
' Space = 32 Ascii, period = 46 Ascii
x = Asc(ExtendMarking1)
If (Asc(ExtendMarking1) = 32 And Asc(ExtendMarking2) = 46) _
Or _
(Asc(ExtendMarking1) = 13 Or Asc(ExtendMarking1) = 11) Then _
' Or (This is beginning of document) put in later ***
' Yes, o.k.
GoTo Continue1:
End If
DontConvert = True
GoTo NoConversion:
Continue1:
' Go back to original cursor position
ActiveDocument.Bookmarks("temp").Select
' Extend marking one char to the right
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'Is this char a lower case char?
If Asc(Selection.Text) < 97 Or Asc(Selection.Text) > 122 Then _
' Not lower case
' DontConvert = True
GoTo NoConversion:
End If
' Lower case
' Change 1st char in remaining text to upper case [A-Z]
Selection.Characters(1).Case = wdUpperCase
NoConversion:
' Res2 contains no. of chars to move forward for insertion
' Goto position to insert marked text
If Res2 = a Then
ActiveDocument.Bookmarks("CR").Select
ElseIf Res2 = b Then
ActiveDocument.Bookmarks("VertTab").Select
ElseIf Res2 = c Then
ActiveDocument.Bookmarks("LikePeriod").Select
ElseIf Res2 = F Then
ActiveDocument.Bookmarks("Period").Select
End If
Branch2:
' Branch for text found within brackets
' Go right one char
Selection.MoveRight Unit:=wdCharacter, Count:=1
' Set 'InsertPos1' bookmark at this position
ActiveDocument.Bookmarks.Add Name:="InsertPos1"
' Go left one char
Selection.MoveLeft Unit:=wdCharacter, Count:=1
If DontConvert = True Then
MarkedText = Chr(32) + MarkedText
Selection.InsertBefore MarkedText
Else
' Move marked text to new position
Selection.InsertBefore NewMarkedText
End If
' Select 'InsertPos1' bookmark
ActiveDocument.Bookmarks("InsertPos1").Select
' If last char moved is ",", then delete it
' Go left two chars
Selection.MoveLeft Unit:=wdCharacter, Count:=2
' Mark next char
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Check if char is ","
' Save last char
LastChar = Selection.Characters(1)
If LastChar = "," Then
Selection.Delete Unit:=wdCharacter, Count:=1
Else
' Move cursor one right again
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
End Sub
Back to Visual Basic Macros Main Page:
Like some details on the programmer?