[第14期]目录提取与自动生成段落[已结]

守柔

Word14期竞赛题目要求:

1.以常规方式将附件文档中一~一百、1~5开头的段落提取到目录中，目录要求从第1页开始。

2.以VBA方式在空白文档中生成该附件文档,每个以中文大写数字开头的段落（相当于一级标题）下有1~5个(随机)以数字1~5开头的"二级标题"(相当于)段落，每个"二级标题"段落下各有1个正文段落，不要求设置标题样式。

3.完成要求1者得1分,需描述操作中的主要步骤.

4.完成1和2者,得2分.如VBA代码高效简洁者可加分.

[此贴子已经被chrisfang于2006-9-5 11:53:56编辑过]

qee用

提取目录操作步骤:
（打开附件文档，光标停留在文档起始处。）
一、查找替换
1.查找内容：、 格式：无样式 替换为：、 格式：标题1 全部替换
2.查找内容：.  格式：无样式 替换为：.  格式：标题2 全部替换
二、生成目录
插入-引用-索引和目录-目录 显示级别：2
三、调整目录页码
（光标仍停留在原文档起始处。）
1.插入-分隔符-分节符类型：下一页
2.插入-页码-格式 起始页码：1
3.还原插入目录前内容的格式
选定目录后的全部内容（即插入目录前原来的内容），编辑-清除-格式
4.更新目录页码
(1)光标点在目录区任一位置
(2)右键-更新域-只更新页码
至此,提取目录结束.

生成段落的VBA代码:

qee用的代码很高效，虽然没有使用域功能，但效率要比使用域高得多。

[此贴子已经被守柔于2006-9-3 5:52:51编辑过]

十年磨一剑

我的常规方法是：

1.查找：[一二三四五六七八九十百]{1,3}*^13

替换为：标题１样式

1.1.查找：[1-5].*^13

替换为：标题2样式

2.定位到开头，插入分节符，“一、”所在的节，插入、页码、格式、起始页码“１”。

3.插入、引用、索引和目录，目录、显示级别：２

PS：感觉正统的保险做法第一步是先查找：^13[一二三四五六七八九十百]{1,3}*^13，再勾选突出所有在该范围找到的项目，查找全部，再点一下标题栏，再在勾选突出所有在该范围找到的项目下找到所选范围，再改查找条件为：[一二三四五六七八九十百]{1,3}*^13。

因为，如果正文也有“一二三四五六七八九十百”的话，上面的第一步会出错。但鉴于老大的原文没有这个，所以。。。

VBA做法是：

Sub Example2()
Dim astring As String
Dim a%, b%, c%, d%, e%
Const bstring = "那只敏捷的狐狸越过那只棕毛懒狗"
Dim atime As Long

atime = Timer
    For b = 0 To 9
        For a = 0 To 9
         c = c + 1
          astring = astring & chinanumber(b, a) & "、" & bstring & c & "。" & Chr(13)
          VBA.Randomize
          d = Int(VBA.Rnd() * 5) + 1
            For e = 1 To d
              astring = astring & e & "." & bstring & "。" & Chr(13)
              astring = astring & bstring & "。" & Chr(13)
            Next
        Next
    Next

 Selection.Text = astring
MsgBox Timer - atime
End Sub
Function chinanumber(b, a) As String
Dim cstring As String
Dim dstring As String

   cstring = Choose(a + 1, "一", "二", "三", "四", "五", "六", "七", "八", "九", "十")
    If b <> 0 Then
        dstring = Choose(b, "", "二", "三", "四", "五", "六", "七", "八", "九")
        If cstring = "十" Then
           dstring = Choose(b + 1, "", "二", "三", "四", "五", "六", "七", "八", "九", "十")
           chinanumber = dstring & cstring
        Else
           chinanumber = dstring & "十" & cstring
        End If
    Else
        chinanumber = cstring
    End If
    If chinanumber = "十十" Then
       chinanumber = "一百"
    End If
   
End Function

守柔

这个题目，本是应网友之邀，为招聘Office并侧重Word软件的应用与开发人员，本题出发点是在Word中的比较“专业”的内容，查找与替换、长文档目录的提取、域应用和VBA编程。

谢谢qee用和十年磨一剑两位网友对此题的支持，另外一方面，由于本人的失误，在首次发表的附件中，竟然附带了VBA代码，这也是导致部分网友无法参加竞赛的一个原因。

一、现将我的做法列出，供参考：

a)        目录的提取：

b)        查找“、”，替换为“标题 1”；

c)        查找“.”，替换为“标题 2”；

d)        在文档首位置，插入一个“下一页”型分节符。

e)        将第二节页眉页脚视图中，设置页码格式/页码编排的起始编号为1。

f)          插入/引用/索引和目录，提取目录。

守柔

一、VBA法反向生成附件文档代码如下：

Option Explicit

Sub Example()

    Dim myString As String, i As Byte, myField As Field

    Dim myRange As Range, A As Byte, B As Byte

    myString = "那只敏捷的狐狸越过那只棕毛懒狗"

    Application.ScreenUpdating = False    '关闭屏幕更新

    With ActiveDocument    '针对活动文档

        For i = 1 To 100    '进入一个循环

            VBA.Randomize    '初始化随机数生成器

            Set myRange = .Range(.Content.End - 1, .Content.End - 1)    '定义一个Range对象

           Set myField = .Fields.Add(myRange, wdFieldEmpty, "= " & i & "\* CHINESENUM3")    '插入一个域,域结果为中文大写数字

            .Content.InsertAfter "、" & myString & myField.Result & "。" & Chr(13)     '插入指定文本

            A = Int(VBA.Rnd() * 5 + 1)    '取得一个1~5的随机数

            For B = 1 To A    '进入一个1~5的循环

                .Content.InsertAfter B & "." & myString & "。" & Chr(13)    '插入指定文本

                .Content.InsertAfter myString & "。" & Chr(13)    '插入指定文本

            Next

        Next

        .Content.Paragraphs.Last.Range.Delete    '删除最后一个段落

        .Fields.Unlink    '切断域链接

    End With

    Application.ScreenUpdating = True    '恢复屏幕更新

End Sub

prince

Option Explicit
Sub prince()
Dim i As Integer, j As Integer
Dim a
Dim myRng As Range
Dim myField As Field
Set myRng = ThisDocument.Content
myRng.Delete Unit:=wdCharacter, Count:=1
For i = 1 To 100
Set myRng = ThisDocument.Range(ThisDocument.Content.Characters.Count - 1, ThisDocument.Content.Characters.Count - 1)
Set myField = myRng.Fields.Add(Range:=myRng, Type:=wdFieldEmpty, Text:= _
       "AUTONUM  \* CHINESENUM3 ", PreserveFormatting:=True)
myRng.InsertAfter " 、EH is my Home! " & i & "。" & Chr(13)
For j = 1 To Int(5 * Rnd + 1)
myRng.InsertAfter j & ".EH is my Home!" & "。" & Chr(13) & "EH is my Home!" & "。" & Chr(13)
Next
Next
End Sub

这段错误代码我始终不知应该如何更正，请版主能详细地说说？一个就是MYRNG的SET语句，一个就是插入域的代码？

gues1688

好久没来竞赛区了。

关于小写整数数值转换为中文大写，用VBA代码的方法，原以为很简单，想了一下不是太容易。

试写一段代码如下：

Option Explicit
Function Num2CNStr(iX As Long) As String  '10亿以下的整数转换为大写
    Dim s1$, s2$, s$, ds$, ts1$, ts2$, k%, i%, iIndex%, StrLen%
    s1 = "一二三四五六七八九十"
    s2 = "十百千万十百千亿"
    s = CStr(iX)
    ds = ""
    k = 1
    StrLen = Len(s)
    For i = StrLen To 1 Step -1
        iIndex = CInt(Mid(s, i, 1))
        If iIndex = 0 Then
            ts1 = IIf(i = StrLen Or i = StrLen - 4 Or k = 0, "", "零")
        Else
            ts1 = Mid(s1, iIndex, 1)
        End If
        If i < StrLen Then ts2 = Mid(s2, StrLen - i, 1)
        ts2 = IIf(i = StrLen Or iIndex = 0 And i <> StrLen - 4, "", ts2)
        ds = ts1 & ts2 & ds
        ds = Replace(ds, "亿万", "亿")
        k = iIndex
    Next
    Num2CNStr = ds
End Function
Sub test()
    Dim str1$
    str1 = Num2CNStr(910000001)
    MsgBox (str1)
End Sub

poetbox

QUOTE:

以下是引用gues1688在2006-9-4 19:58:45的发言：

好久没来竞赛区了。

关于小写整数数值转换为中文大写，用VBA代码的方法，原以为很简单，想了一下不是太容易。

试写一段代码如下：

Option Explicit
Function Num2CNStr(iX As Long) As String  '10亿以下的整数转换为大写
    Dim s1$, s2$, s$, ds$, ts1$, ts2$, k%, i%, iIndex%, StrLen%
    s1 = "一二三四五六七八九十"
    s2 = "十百千万十百千亿"
    s = CStr(iX)
    ds = ""
    k = 1
    StrLen = Len(s)
    For i = StrLen To 1 Step -1
        iIndex = CInt(Mid(s, i, 1))
        If iIndex = 0 Then
            ts1 = IIf(i = StrLen Or i = StrLen - 4 Or k = 0, "", "零")
        Else
            ts1 = Mid(s1, iIndex, 1)
        End If
        If i < StrLen Then ts2 = Mid(s2, StrLen - i, 1)
        ts2 = IIf(i = StrLen Or iIndex = 0 And i <> StrLen - 4, "", ts2)
        ds = ts1 & ts2 & ds
        ds = Replace(ds, "亿万", "亿")
        k = iIndex
    Next
    Num2CNStr = ds
End Function
Sub test()
    Dim str1$
    str1 = Num2CNStr(910000001)
    MsgBox (str1)
End Sub

借助域的数值参数，VBA应该可以简化很多。至少不必从源头写起。

999lhg999

下载了，学习学习！

wangpeng594

牛人一群！！！{:soso_e179:}