Custom Search

Drag & Drop Macro (Visual Basic)

* * *

This is a macro written in Visual Basic to run on Microsoft Word

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?