View Single Post
  #14   Report Post  
Posted to microsoft.public.word.docmanagement
Peter T. Daniels Peter T. Daniels is offline
external usenet poster
 
Posts: 3,215
Default macro for transposing letters Supress "Opening this documentwith run the following SQL command"

Turns out it works at normal speed in a small (10-p.) document; the
one it's slow in is 180 pp. But since the pair of characters it works
on is the two characters on either side of the cursor (or two selected
characters), why would it need to search the entire file?

On Aug 22, 8:45*am, "Peter T. Daniels" wrote:
Here's the code:

SubTranspose()
Dim oRng As Range
Dim sText As String
Dim Msg1 As String
Dim Msg2 As String
Dim Msg3 As String
Dim MsgTitle As String
Msg1 = "You must place the cursor between " & _
* * * *"the 2 characters to be transposed!"
Msg2 = "There are no characters totranspose?"
Msg3 = "There is no document open!"
MsgTitle = "TransposeCharacters"
On Error GoTo ErrorHandler
If ActiveDocument.Characters.Count 2 Then
* * Set oRng = Selection.Range
* * Select Case Len(oRng)
* * Case Is = 0
* * * * If oRng.Start = oRng.Paragraphs(1).Range.Start Then
* * * * * * MsgBox Msg1, vbCritical, MsgTitle
* * * * * * Exit Sub
* * * * End If
* * * * If oRng.End = oRng.Paragraphs(1).Range.End - 1 Then
* * * * * * MsgBox Msg1, vbCritical, MsgTitle
* * * * * * Exit Sub
* * * * End If
* * * * With oRng
* * * * * * .Start = .Start - 1
* * * * * * .End = .End + 1
* * * * * * .Select
* * * * * * sText = .Text
* * * * End With
* * Case Is = 1
* * * * MsgBox Msg1, vbCritical, MsgTitle
* * * * Exit Sub
* * Case Is = 2
* * * * sText = Selection.Range.Text
* * Case Else
* * * * MsgBox Msg1, vbCritical, MsgTitle
* * * * Exit Sub
* * End Select
* * With Selection
* * * * If .Range.Characters(1).Case = 1 _
* * * * * * And .Range.Characters(2).Case = 0 Then
* * * * * * .TypeText UCase(Mid(sText, 2, 1)) & _
* * * * * * LCase(Mid(sText, 1, 1))
* * * * Else
* * * * * * .TypeText Mid(sText, 2, 1) & _
* * * * * * Mid(sText, 1, 1)
* * * * End If
* * * * .MoveLeft wdCharacter
* * End With
Else
* * MsgBox Msg2, vbCritical, MsgTitle
End If
End
ErrorHandler:
If Err.Number = 4248 Then
* * MsgBox Msg3, vbCritical, MsgTitle
End If
End Sub

On Aug 22, 1:57*am, "Graham Mayor" wrote:



I have not been away With such low traffic, there have been few
opportunities to comment.
I don't remember the particular macro, but I don't use Windows 7 so cannot
check it out. If you post the code, someone else may be able to check it.