[求助]英文试题排版（困扰我两年了）

adayun

各位大虾，请帮忙看看这种英文试题，怎么用ＷＯＲＤ排版啊！！！

 

mJQSkjIH.rar (192.69 KB, 下载次数: 34)

2008-4-12 00:56 上传

点击文件名下载附件
[求助]英文试题排版（困扰我两年了）

tangqingfu

最好是将文件用doc文档格式上传，而非pdf格式。

另外请楼主最好说清需要达到的具体要求，而非一句话带过，让大家猜题。

istudyexcel

很容易实现啊.就按正常编辑.上面的加下划线,下划线下面的大写字母单独输一行移到相应位置就可以了.最后再调整一下行间距. 如果用文本框的话,太麻烦了.

adayun

QUOTE:

以下是引用istudyexcel在2008-4-12 7:40:58的发言：

很容易实现啊.就按正常编辑.上面的加下划线,下划线下面的大写字母单独输一行移到相应位置就可以了.最后再调整一下行间距. 如果用文本框的话,太麻烦了.

我以前一直是用这样的方法，

但要调整在下划线下单词的位置，敲那么多Tap，空格总觉得太累，有时感觉还是不在正中间

特别是在一篇短文中增加，减少一两个单词时要全部调整，挺麻烦的

大虾们有无更好的方法

sylun

可试试如下程序：

Sub Marking()
'运行本程序前请先对需编号标记的内容加下划线
Dim oRange As Range, myPar As Paragraph, myRange As Range, oh As Single, n As Byte
Dim pl As Long, pt As Long, pw As Long, ph As Long, w As Single, h As Single, myShape As Shape
Application.ScreenUpdating = False
'如果没有选定区域则进行全文档处理
Set oRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
'编号规则暂定为段落不同重新编号
For Each myPar In oRange.Paragraphs
    Set myRange = myPar.Range
    oh = myRange.Characters(1).Information(wdVerticalPositionRelativeToTextBoundary)
    With myRange.Find
        .ClearFormatting
        .Format = True
        .Font.Underline = wdUnderlineSingle
        Do While .Execute
            n = n + 1
            With myRange
                .Font.Underline = wdUnderlineNone
                .Fields.Add myRange, wdFieldEmpty, "eq \o(\x\bo(" & .Text & "))", False
                .MoveEnd
                .Fields(1).Code.Text = RTrim(.Fields(1).Code.Text)
                .Select
                ActiveWindow.GetPoint pl, pt, pw, ph, Selection.Range
                pl = PixelsToPoints(pl)
                pt = PixelsToPoints(pt)
                pw = PixelsToPoints(pw)
                ph = PixelsToPoints(ph)
                w = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
                h = Selection.Information(wdVerticalPositionRelativeToTextBoundary)
                Set myShape = Me.Shapes.AddTextbox(msoTextOrientationHorizontal, w, h - oh + .Font.Size + 2, pw, ph, myPar.Range)
                With myShape
                    .Select
                    .Height = .Height - .TextFrame.MarginTop - .TextFrame.MarginBottom
                    .Width = .Width - .TextFrame.MarginLeft - .TextFrame.MarginRight
                    .TextFrame.MarginTop = 0
                    .TextFrame.MarginBottom = 0
                    .TextFrame.MarginLeft = 0
                    .TextFrame.MarginRight = 0
                    .Line.Visible = msoFalse
                    .Fill.Visible = msoFalse
                    Selection.HomeKey
                    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                    Fields.Add Selection.Range, wdFieldEmpty, "=" & n & " \*ALPHABETIC", False
                End With
                .SetRange .End, myPar.Range.End
            End With
        Loop
    End With
    n = 0
Next
Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2008-4-12 14:49:12编辑过]

sylun

<p>换另一种方法处理：不用EQ域，保留下划线，复原时只需清除文本框。<br/><br/>Sub oMarking2()<br/>'运行本程序前请先对需编号标记的内容加下划线<br/>Dim myzm As Integer, oRange As Range, myPar As Paragraph, myRange As Range, oh As Single, n As Integer, TF As Boolean<br/>Dim pl As Long, pt As Long, pw As Long, ph As Long, w As Single, h As Single, myShape As Shape<br/>On Error GoTo hd<br/>Application.ScreenUpdating = False<br/>ActiveDocument.ActiveWindow.View.ShowFieldCodes = False<br/>myzm = ActiveWindow.ActivePane.View.Zoom<br/>ActiveWindow.ActivePane.View.Zoom = 100<br/>'如果没有选定区域则进行全文档处理<br/>Set oRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)<br/>'编号规则暂定为段落不同重新编号<br/>For Each myPar In oRange.Paragraphs<br/>&nbsp;&nbsp;&nbsp; Set myRange = myPar.Range<br/>&nbsp;&nbsp;&nbsp; oh = myRange.Characters(1).Information(wdVerticalPositionRelativeToTextBoundary)<br/>&nbsp;&nbsp;&nbsp; With myRange.Find<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .ClearFormatting<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Format = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Font.Underline = wdUnderlineSingle<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Do While .Execute<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; n = n + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With myRange<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Select<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '判断当前选定位置与所在段落首字符是否同页<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If .Characters(1).Information(wdActiveEndPageNumber) &lt;&gt; myPar.Range.Characters(1).Information(wdActiveEndPageNumber) _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Then TF = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ActiveWindow.GetPoint pl, pt, pw, ph, Selection.Range<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pw = PixelsToPoints(pw)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ph = PixelsToPoints(ph)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; w = Selection.Information(wdHorizontalPositionRelativeToTextBoundary)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; h = Selection.Information(wdVerticalPositionRelativeToTextBoundary)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set myShape = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, w, _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; IIf(TF, h, h - oh) + .Font.Size, pw, ph, IIf(TF, myRange, myPar.Range))<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With myShape<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.MarginTop = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.MarginBottom = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.MarginLeft = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.MarginRight = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Line.Visible = msoFalse<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Fill.Visible = msoFalse<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Fields.Add .TextFrame.TextRange, wdFieldEmpty, "=" & n & " \*ALPHABETIC", False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.TextRange.Font.Size = myRange.Font.Size<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.TextRange.ParagraphFormat.LineSpacingRule = myRange.ParagraphFormat.LineSpacingRule<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .TextFrame.TextRange.ParagraphFormat.LineSpacing = myRange.ParagraphFormat.LineSpacing<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '同一项下划线内容如出现换行，编号标记在第一行<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Selection.Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; &lt;&gt; Selection.Characters.Last.Information(wdVerticalPositionRelativeToTextBoundary) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Height = .Height / 2 '假设同一项内容不超过两行<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Width = ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; - ActiveDocument.PageSetup.RightMargin - ActiveDocument.PageSetup.Gutter - w<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .SetRange .End, myPar.Range.End<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; TF = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Loop<br/>&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp; n = 0<br/>Next<br/>ActiveDocument.ActiveWindow.ActivePane.View.Zoom = myzm<br/>oRange.Select<br/>Application.ScreenUpdating = True<br/>Exit Sub<br/>hd: MsgBox "程序出现意外，终止运行！"<br/>End Sub</p><p>补充修改：加了两句，试图适应对段落行间距的特殊设置，但还不适应段前段后间距的特殊设置。测试文档如下：</p> 19cvJtCb.rar (21.43 KB, 下载次数: 20)

2008-6-13 01:22 上传

点击文件名下载附件

<br/>

[此贴子已经被作者于2008-6-13 1:22:47编辑过]

对附件中代码的更新： 在下划线下标记选项.rar (24.01 KB, 下载次数: 15)

2009-4-26 08:52 上传

点击文件名下载附件

[ 本帖最后由 sylun 于 2009-4-26 08:52 编辑 ]

jhxxl

是这样的效果吗?

mhug5XfQ.rar (76.08 KB, 下载次数: 22)

2008-4-21 17:18 上传

点击文件名下载附件

[此贴子已经被作者于2008-4-21 17:18:26编辑过]

adayun

非常感谢各位大虾的解答，学习了

这几天外出了．没及时回复，请大虾们谅解！

masterexcel

象5楼的那样，用eq域

tangqingfu

请教sylun兄,代码能放在normal的NewMacros里吗?我放进去,运行代码,弹出"程序出现意外，终止运行！",请sylun兄帮忙.

如果放在ThisDocument里,则可行,但有个问题,如果在替换后对文档的字号重新设置,改错题的选项A、B、C、D等字号不会随之变化（还是不变）

[此贴子已经被作者于2008-6-13 1:48:50编辑过]