View Single Post
  #17   Report Post  
Posted to microsoft.public.word.docmanagement
Graham Mayor Graham Mayor is offline
external usenet poster
 
Posts: 19,312
Default "Transpose" macro Hebrew / right-to-left text

Following up with the revised version of the transposition macro I mentioned
yesterday: The following will transpose either two selected characters or
the characters either side of the cursor and allows for those cases where
the cursor is not located between two characters or more than two characters
are selected. The cursor is left between the transposed characters so
repeated use of the macro will toggle the transposition back and forth. I
have added this version to my web page
http://www.gmayor.com/word_vba_examples.htm#Transpose

Sub Transpose()
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 to transpose?"
Msg3 = "There is no document open!"
MsgTitle = "Transpose Characters"
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


--

Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site http://word.mvps.org



Peter T. Daniels wrote:
Oh, I wasn't talking about typos in Hebrew -- though in Modern Hebrew
the problem you raise will rarely come up, as the vowel points are
rarely used (except in didactic texts and poetry).

So, thanks again to Graham for a transposing tool!

On Oct 11, 12:14 pm, "Tony Jollans" My forename at my surname dot
com wrote:
I think this is fraught with difficulty - almost by definition you
are dealing with complex scripts, and you really need to examine the
selection for combining characters. I don't know Hebrew, but just as
an example, consider the character ?? - this is a letter bet (?)
with a combining point sheva (?) below it - it is two characters
(overlaid) in Word and swapping them round - indeed doing anything
with them other than treating them as a single unit - is totally
destructive.

I hope this shows up properly in your newsreader - if not, the
characters are U+5D1 (bet) and U+5B0 (sheva).

--
Enjoy,
Tony

www.WordArticles.com

"Graham Mayor" wrote in message

...



OK, but a little more error handling wouldn't hurt (and it would be
possible to either put the cursor between the characters or select
them, but I haven't time to add that now. Maybe tomorrow).


Sub Transpose()
Dim oRng As Range
Dim sText As String
On Error GoTo ErrorHandler
If ActiveDocument.Characters.Count 2 Then
Set oRng = Selection.Range
If Len(oRng) 0 Then
MsgBox "You must place the cursor between the 2 characters to be
transposed!", _
vbCritical, "Transpose Characters"
Exit Sub
End If
With oRng
.Start = .Start - 1
.End = .End + 1
.Select
sText = .Text
End With
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 "Empty document", _
vbCritical, "Transpose Characters"
End If
End
ErrorHandler:
If Err.Number = 4248 Then
MsgBox "No document open", _
vbCritical, "Transpose Characters"
End If
End Sub


--

Graham Mayor - Word MVP


My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org


Peter T. Daniels wrote:
I should Bookmark that in my browser ...


One other thing (I hoped to add this before you saw the thread
again!): can you make it work on two characters that the cursor is
between, rather than having to select the two characters?


On Oct 11, 9:48 am, "Graham Mayor"
wrote:
http://www.gmayor.com/installing_macro.htm


--

Graham Mayor - Word MVP


My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org


Peter T. Daniels wrote:
Wow -- I don't think anyone's bothered to fix the _case_ where
it's involved in a transposition before! And Ctrl-T is the
Hanging Indent shortcut -- which I always do with either the
Ruler or the Paragraph Format tool, since anything automatic
would have to be adjusted anyway,so it will have its own
perfectly intuitive command! Thanks! Now to relocate the
install-macro instructions ...


On Oct 11, 2:02 am, "Graham Mayor"
wrote:.


As for transposing two selected characters, that macro would
work, but I suspect the following refinement might suit the
task better


Sub Transpose()
Dim sText As String
sText = Selection.Range.Text
If Len(sText) 2 Then
MsgBox "You must select 2 characters!", _
vbCritical, "Transpose Characters"
Exit Sub
End If
If Selection.Range.Characters(1).Case = 1 _
And Selection.Range.Characters(2).Case = 0 Then
Selection.TypeText UCase(Mid(sText, 2, 1)) & _
LCase(Mid(sText, 1, 1))
Else
Selection.TypeText Mid(sText, 2, 1) & _
Mid(sText, 1, 1)
End If
End Sub


--

Graham Mayor - Word MVP


My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
--