新手，提供代码请高人做个宏程序，直接加载可以用的那种

plg123 · 发表于 2007-4-27 10:53

WORD提供了十分强大的查找和替换功能，但是，在日常办公中还会遇到许多该功能完成不了的工作。使用WORD的VBA编写少量的程序代码就可以突破这些限制，完成很多复杂的工作。

本文提供一个查找并替换数字的宏程序，用来完成复杂的数字查找和按一定规则替换数字的功能，简化WORD文档的编撰过程。下面介绍程序设计中需要考虑并克服的几个难点，最后给出源程序及其使用方法。该程序在WORD 2000下开发完成，经测试不能在WORD 97下正常运行。

问题的由来

当需要将WORD文档中的一种单位制的数据转换成另一种单位制的数据时（如将市制或英制转换为公制），不仅要在文档中查找特定单位的数据，还需要用计算器按规则计算目标结果，并将其输入到文档中替换原来的值。如果只是处理少量的数据，这样的操作可以接受。但如果在文档中有几十个或成百上千个这样的数据或有多个同类文档，这个处理过程就会非常繁琐，而且容易出错。

我曾经有过一次这样的经历：一篇WORD文档中有3个十分复杂的表格，有几千个数据，所有的数据需要进行单位变换，开始的时候，我认为比较容易，只要把表格中的数据复制到EXCEL，按规则转换后再写回到WORD文档就可以了，不料由于表格过于复杂，当复制到EXCEL中后，数据面目全非，即使数据全部正确被转换，也很难在WORD中恢复数据的原貌，使本来貌似简单的工作变得异常复杂。

经常遇到这类情况使我决心用WORD的VBA来彻底解决这个问题。但是存在几个棘手的问题，例如选中数据的通用方法、按规则替换数据的方法、只对文档的特定部分进行操作等等。下面将介绍解决这些问题的基本思路。

选中数字的通用方法

使用WORD的查找功能可以找到特定格式的数字，比如由一位整数和两位小数组成的数——2.34、3.45、5.34——可以使用通用数字格式"^#.^#^#"来查找，其中一个^#相当与一位数字（0－9）。如果你需要查找23.2、3.222、4.3、0.12这样的几个数字，只用WORD的查找功能，是很难用一个通用数字格式串找到它们的。那么如何找到它们呢？

首先它们的共同点是都有小数点，所以我们可以利用这一共性，查找"^#.^#"类型的数字，这样我们可以找到所有这样的数字。但WORD不会自动扩展性地选择整个数字，需要手动选择。这一过程可以程序化，让程序自动向前先后搜索，找到并选中整个数字，具体方法请参阅ExtendingSelection1()和ExtendingSelection2()两个过程。

按一定规律替换选中的数字

当找到一个数字之后，需要根据特定的规则来替换它们，比如在华氏温度数据和摄氏温度数据之间转换时，其转换公式是：摄氏温度＝（华氏温度－32）*5/9，这时就需要使用计算器根据当前值进行计算，然后输入计算结果。若一个一个地操作，实在是太乏味了，而且极易出错，那么如何处理呢？

在上一节中，我们讲用程序自动选中整个数字，那么这个选中的数字就是我们计算的起点，首先估计选中字符串的值，用给定的公式进行计算，根据指定的数值精度对其进行四舍五入，然后替换掉选中的字符串即可，这些工作由程序来完成是比较容易的，具体方法请参阅CalculateNReplace()过程。

替换文档的特定部分

有时我们不希望对整个文档进行操作，而是对文档中的特定部分进行查找并替换操作。若使用WORD的查找并替换功能，只需要选中特定的文档部分即可。但是对VBA宏程序来说，存在一个小问题：WORD只允许一个文档拥有一个SELECTION对象，当程序在向前或向后扩展选中的数字时，该SELECTION对象即丢失。为了解决这个问题，我们需要创建一个临时文档，将选中的文档部分复制到新创建的文档中，然后对其执行上述的查找并按规则替换数字的功能，执行完毕再将整个文档放到WINDOWS的剪贴板，关闭该文档并回到原文档中，替换掉原文档中的选中部分。具体方法请参阅NewDoc()和ReplaceDoc()两个过程。

估计数学表达式的方法

如果允许用户给输入参数指定一个数值表达式，在使用它们之前需要首先估计它们的值。这需要用到WORD的等式域（FORMULA或＝）功能。首先将用户在对话窗体上输入的数值表达式提取出来，创建一个新文档，向文档写入一个相应的等式域来估计该表达式，选中域值文本，将其转换为对应的双精度数值，供程序使用，当所有的表达式都估计结束后，关闭该临时文档即可。具体方法请参见CalculateFormula()过程。这种方法比用程序直接解析数值表达式要来得直接和容易。 窗体和程序设计

单击WORD的"工具"*"宏"*"Visual Basic 编辑器"，启动Visual Basic 编辑器。单击其菜单栏上的命令"插入"*"添加用户窗体"，添加一个空白用户窗体，在窗体上添加多页（MultiPage）、组合框（Frame）、下拉列表框（ComoBox）、选择框（CheckBox）、标签（Label）、文本编辑（TextBox）和命令按钮（CommandButton）控件，修改它们的默认属性至相应的值，作成一个象图1和图2所示的对话窗口。

图1 查找并按规则替换数字的对话窗口(1)

图2 查找并按规则替换数字的对话窗口(2)

由于窗口控件较多，限于篇幅，这里不赘述，读者可以从下载的模板文件中看到具体的细节。窗体设计好后，在代码编辑框中输入下面的源程序代码。为了用户的使用方便，在窗体的初始化例程（UserForm_Initialize()）中预置了几个常用的数字格式，有："^#.^#"，"^#"，"^#^#"，"^#^#^#"，"0.^#"，"-^#.^#"，"-^#"。

源程序代码：

Dim DocName
Dim Multiple, ConstCoef, Precise
Dim iCount
Dim FindUnitStr, RepUnitStr
Private Sub btnCancel_Click()
   frmReplaceNumber.Hide
End Sub

Private Sub btnOK_Click()
    On Error Resume Next
    If tbA.Text = "" Then
        MsgBox ("You have to enter at least a number for the slope!")
    Else
        If Selection.Type = wdSelectionIP Then
            ReplaceNumber
        Else
            NewDoc
            ReplaceNumber
            ReplaceDoc
        End If
    End If
    frmReplaceNumber.Hide
End Sub
Private Sub NewDoc()
    DocName = ActiveDocument.Name
    Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.WholeStory
    Selection.Paste
    Selection.HomeKey Unit:=wdStory
End Sub
Private Sub ReplaceDoc()
    Selection.WholeStory
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Copy
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    Windows(DocName).Activate
    Selection.Paste
End Sub
Private Function isASpecificChar(AChar, SpecificChar)
    isASpecificChar = (Asc(AChar) = Asc(SpecificChar))
End Function
Private Function isADigit(Ch)
    isADigit = (Asc(Ch) >= Asc("0") And Asc(Ch) <= Asc("9"))
End Function
Private Sub ExtendingSelection2()
    iCount = 0
    isDigit = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Do
        isSpace = False
        If Selection.MoveLeft = 1 Then
            TempChar = Left(Selection.Text, 1)
            isSpace = isASpecificChar(TempChar, Chr(32))
            If isSpace Then
                FindUnitStr = TempChar + FindUnitStr
                RepUnitStr = TempChar + RepUnitStr
            Else
                isDigit = isADigit(TempChar)
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        End If
    Loop While isSpace
    While isDigit
        isDigit = False
        If Selection.MoveLeft = 1 Then
            TempChar = Left(Selection.Text, 1)
            isDigit = (isASpecificChar(TempChar, ".") Or isADigit(TempChar))
            If isDigit Then
                iCount = iCount + 1
            Else
                Selection.MoveRight Unit:=wdCharacter, Count:=1
            End If
        End If
    Wend
    Selection.MoveRight Unit:=wdCharacter, Count:=iCount, Extend:=wdExtend
End Sub
Private Sub ExtendingSelection1()
    iCount = Len(Selection.Text)
    Do
        isDigit = False
        If Selection.MoveRight = 1 Then
            TempChar = Left(Selection.Text, 1)
            isDigit = isASpecificChar(TempChar, ".") Or isADigit(TempChar)
            If isDigit Then iCount = iCount + 1
        End If
    Loop While isDigit
    Selection.MoveLeft Unit:=wdCharacter, Count:=iCount
    If InStr(FindStr, "-") <> 1 Then ' if it is not a negative number, do the loop
        Do
            isDigit = False
            If Selection.MoveLeft = 1 Then
                TempChar = Left(Selection.Text, 1)
                isDigit = isASpecificChar(TempChar, ".") Or isADigit(TempChar)
                If isDigit Then
                    iCount = iCount + 1
                Else
                    Selection.MoveRight Unit:=wdCharacter, Count:=1
                End If
            End If
        Loop While isDigit
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=iCount, Extend:=wdExtend
End Sub
Private Sub CalculateFormula()
    Dim TempDocName
    FormatStr = "#.00000000000000x"
    TempDocName = ActiveDocument.Name
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.WholeStory
    Selection.InsertFormula Formula:="=" & tbA.Text, NumberFormat:=FormatStr
    Selection.WholeStory
    Multiple = CDbl(Selection.Text)
    If tbB.Text <> "" Then
        Selection.InsertFormula Formula:="=" & tbB.Text, NumberFormat:=FormatStr
        Selection.WholeStory
        ConstCoef = CDbl(Selection.Text)
    End If
    If tbPrecise <> "" Then
        Selection.InsertFormula Formula:="=" & tbPrecise.Text,
NumberFormat:=FormatStr
        Selection.WholeStory
        Precise = CDbl(Selection.Text)
    Else
        Precise = 2
    End If
    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
    Windows(TempDocName).Activate
End Sub
Private Sub CalculateNReplace()
    d = CDbl(Selection.Text)
    If (d <> 0) Then
        Value = d * Multiple + ConstCoef
        TempStr = CStr(Round(Value, Precise))
        If InStr(TempStr, ".") <> 0 Then
            While (Asc(Left(Right(TempStr, Precise + 1), 1)) <> Asc("."))
                TempStr = TempStr + "0"
            Wend
        ElseIf Precise > 0 Then
            TempStr = TempStr + "."
            For i = 1 To Precise
                TempStr = TempStr + "0"
            Next
        End If
        If MultiPage1.Value = 1 Then
            TempStr = TempStr + RepUnitStr
            Selection.MoveRight Unit:=wdCharacter, Count:=Len(FindUnitStr),
Extend:=wdExtend
        End If
        Selection.Text = TempStr
    End If
End Sub
Private Sub ReplaceNumber()
    On Error Resume Next
    CalculateFormula
    FindStr = ""
    RepStr = ""
    Select Case MultiPage1.Value
    Case 0:
        FindStr = cobFindStr.Text
        RepStr = ""
    Case 1:
        FindStr = tbFindUnit.Text
        RepStr = tbRepUnit.Text
    End Select
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = FindStr
        .Replacement.Text = RepStr
        .Forward = True
        .Wrap = wdFindStop
    End With
    While Selection.Find.Execute
        Select Case MultiPage1.Value
        Case 0: ' by number
            If Not cbNoExtend.Value Then
                ExtendingSelection1
            End If
        Case 1: ' by unit
            FindUnitStr = FindStr
            RepUnitStr = RepStr
            ExtendingSelection2
        End Select
        If iCount > 0 Then CalculateNReplace
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Wend
End Sub

Private Sub UserForm_Initialize()
   Load frmReplaceNumber
   cobFindStr.AddItem ("^#.^#")
   cobFindStr.AddItem ("^#")
   cobFindStr.AddItem ("^#^#")
   cobFindStr.AddItem ("^#^#^#")
   cobFindStr.AddItem ("0.^#")
   cobFindStr.AddItem ("-^#.^#")
   cobFindStr.AddItem ("-^#")
End Sub

使用方法

当完成了窗体设计并输入了正确的程序代码后，还需要设计一个启动窗体的代码。单击Visual Basic编辑器菜单栏上的"插入"*"添加模块"命令，在代码编辑窗口输入如下程序段：

Sub ReplaceNumber()
    frmReplaceNumber.Show
End Sub

完成上述步骤后，保存当前的工作，回到WORD，就可以使用该宏命令了。将插入点移到需要替换的数字前面或选中特定的文档区域，运行这个宏，弹出一个对话窗口（见图1-2）。

依照数字来查找并替换的步骤如下：

步骤1：在"依数字"页上的"查找"下拉列表框中选中一种通用数字格式，或者自己在编辑框中输入一个有效的通用数字格式串；

步骤2：如果你需要精确匹配数据格式，选中"不扩展选中的文本"选项；

步骤3：在"结果＝A×当前值＋B"部分，在A和B编辑框中输入一个有效的数字表达式，如果某项无值，将对应的编辑框置空即可。在小数位数编辑框中输入数字的有效精度（即小数的位数）；

步骤4：单击确定按钮执行程序。

依照单位来查找并替换的步骤如下：

步骤1：单击"依单位"选项页，切换页面，在"查找"编辑框中输入需要查找的单位，在"替换为"编辑框中输入将要替换为的单位；

步骤2、3、4：与第一种方法相同，不赘述。

plg123 · 发表于 2007-4-27 10:55

请高人根据上面的意思做个宏程序，直接加载就可以用的那种，谢谢

plg123 · 发表于 2007-4-27 13:49

怎么没人理阿？？[em02]

		自动登录	找回密码
密码			免费注册