[讨论][求助]如何实现文字方向的从右起向左的排版

qinyunxue

以下是以VBA 编写的代码，可实现一行中的文字变化为从右起向左的功能。但是要实现整段的变换就会发生行序也发生倒换的情况，有高手能解决的话，请帮忙实现1、输入中文时，出文可从右起向左；2、把从左起向右的文档（整段，整行，注意数字方向不变化）实现完美转换为从右起向左。感谢！ 宏代码的导入方法： 将附件代码存文为 Normal NewMcros.bas , 以Word 中 工具\宏\VB编辑器\文件\导入文件 导入，然后通过 调试\编译Projet 后返回Word ，选取 工具\自定义\命令\宏, 再拖曳 Normal NewMacros 到工具栏，实现功能模块嵌入，文本输入窗中选取一行文字，点按 工具栏中的Normal NewMacros按钮即可实现从右起向左的文字方向转换 附实行整行文字转换为从右起向左功能代码： Sub Macro1() ' ' Macro1 Macro ' 宏在 2006-4-2 由 MHY 录制 ' Dim str, strtemp1, out, strtemp, st2, st3, st4, st5, st6, st7, st8, st9, st10, st11, st12, st13 As String Dim i, j, n, m, k, x, y, z, u, v, w As Integer str = Selection.Text strtemp1 = str m = Len(str) i = 1 Do While (i <= m - 1) st7 = Mid$(str, i, 1) If (st7 = "）") Then x = i Exit Do End If i = i + 1 Loop Selection.Text = x End Sub Sub Macro2() ' ' Macro2 Macro ' 宏在 2006-4-2 由 MHY 录制 ' Dim ft, f1, f2, f3, f4, f5, f6 As String ft = Selection.Range.Text n = Len(ft) f1 = Mid$(ft, 1, 1) f5 = Mid$(ft, 2, n - 1) f2 = Chr(10) & f1 f3 = f2 & f5 Selection.Text = f3 End Sub Sub re_to() ' ' re_to Macro ' 宏在 2006-4-2 由 MHY 创建 ' Dim ft, d1, d2 As String Dim j As Integer ft = Selection.Range.Text j = Len(ft) If ((Mid$(ft, j, 1)) = "（") Then d2 = Mid$(ft, 1, j - 1) ft = d2 & "）" End If Selection.Text = ft End Sub Sub my_line() ' ' my_line Macro ' 宏在 2006-4-3 由 MHY 创建 ' 'Dim ft As String Dim str, out, strtemp As String Dim i As Integer Dim strch As String * 1 str = Selection.Text strtemp = Trim(str) For i = 1 To Len(strtemp) strch = Mid$(strtemp, i, 1) If Not (strch = " ") Then out = out & strch End If Next i Selection.Text = out End Sub Sub Macro3() ' ' Macro3 Macro ' 宏在 2006-4-3 由 MHY 录制 If (((Mid$(st5, 1, 1))) = "，") Then s2 = Mid$(st5, 2, j - 1) s3 = Chr(10) & "，" st5 = s3 & s2 End If If (((Mid$(st5, 1, 1))) = "。") Then s2 = Mid$(st5, 2, j - 1) s3 = Chr(10) & "。" st5 = s3 & s2 End If If (((Mid$(st5, 1, 1))) = "！") Then s2 = Mid$(st5, 2, j - 1) s3 = Chr(10) & "！" st5 = s3 & s2 End If If (((Mid$(st5, 1, 1))) = "？") Then s2 = Mid$(st5, 2, j - 1) s3 = Chr(10) & "？" st5 = s3 & s2 End If ' Application.Run MacroName:="my_line" End Sub Sub my_line3() ' ' my_line3 Macro ' 宏在 2006-4-3 由 MHY 创建 ' Dim str, strtemp1, out, strtemp, st2, st3, st4, st5, st6, st7, st8, st9, st10, st11, st12, st13 As String Dim s1, s2, s3, s4, s5 As String Dim i, j, n, m, k, x, y, z, u, v, w As Integer Dim d1, d2, d3, d4 As String Dim j1, j2, j3 As Integer str = Selection.Text strtemp1 = str m = Len(str) strtemp = Mid$(str, m, 1) If (strtemp = Chr(13)) Then st2 = Mid$(strtemp1, 1, m - 1) st3 = StrReverse(st2) st4 = Mid$(strtemp1, m, 1) st5 = st3 & st4 Else st6 = Mid$(strtemp1, 1, m) st5 = StrReverse(st6) End If If (st4 = Chr(13)) Then j = m - 1 i = j Else j = m i = j End If Do While (i >= 1) st7 = Mid$(st5, i, 1) If (st7 = "（") Then x = i - 1 Do While (x >= 1) st8 = Mid$(st5, x, 1) If (st8 = "）") Then If (Val(Mid$(st5, x + 1, 1)) <> 0) Then st12 = Mid$(st5, x, i - x + 1) st13 = StrReverse(st12) st5 = Replace(st5, st12, st13) i = x - 1 Else st5 = Replace(st5, "）", "a") st5 = Replace(st5, "（", "b") st5 = Replace(st5, "a", "（") st5 = Replace(st5, "b", "）") End If End If x = x - 1 Loop i = x - 1 End If i = i - 1 Loop st5 = Replace(st5, "《", "c") st5 = Replace(st5, "》", "d") st5 = Replace(st5, "c", "》") st5 = Replace(st5, "d", "《") st5 = Replace(st5, "“", "e") st5 = Replace(st5, "”", "f") st5 = Replace(st5, "e", "”") st5 = Replace(st5, "f", "“") st5 = Replace(st5, "‘", "g") st5 = Replace(st5, "’", "h") st5 = Replace(st5, "g", "’") st5 = Replace(st5, "h", "‘") If ((Mid$(st5, j, 1)) = "（") Then d2 = Mid$(st5, 1, j - 1) st5 = d2 & "）" End If j1 = j - 2 If (j > 7) Then Do While (j1 >= j - 6) If ((Mid$(st5, j1, 1)) = "）" And (Val(Mid$(st5, j1 + 1, 1)) <> 0)) Then d2 = Mid$(st5, 1, j1 - 1) d3 = Mid$(st5, j1 + 1, j - j1 + 1) st5 = d2 & "（" & d3 j1 = j1 - 1 Else j1 = j1 - 1 End If Loop End If Selection.Text = st5 End Sub Sub 带标点() ' ' 带标点 Macro ' 宏在 2006-4-4 由 MHY 创建 ' Dim str, strtemp1, out, strtemp, st2, st3, st4, st5, st6, st7, st8, st9, st10, st11, st12, st13 As String Dim s1, s2, s3, s4, s5 As String Dim i, j, n, m, k, x, y, z, u, v, w As Integer Dim d1, d2, d3, d4 As String Dim j1, j2, j3 As Integer str = Selection.Text strtemp1 = str m = Len(str) strtemp = Mid$(str, m, 1) If (strtemp = Chr(13)) Then st2 = Mid$(strtemp1, 1, m - 1) st3 = StrReverse(st2) st4 = Mid$(strtemp1, m, 1) st5 = st3 & st4 Else st6 = Mid$(strtemp1, 1, m) st5 = StrReverse(st6) End If Selection.Text = st5 End Sub

[此贴子已经被作者于2006-4-6 1:09:22编辑过]

守柔

请楼主上传带宏文件和运行前后的比较文本。

可能是论坛网页关系，代码错乱，整理后感到有些不舒服。