求VBA代码

yuyvtul

我的目的用自动图文集不能解决，不是自造字的问题，按版主的代码，改动汉字范围，就可用自造字，这已测试成功。

问题是自动图文集本身的限制：当词条为单个汉字时，若前面有汉字就不行，例如“艽→中国人民”可以，但在“艽艽”及“三艽”后面按F3根本不起作用。

另外，版主的代码运行后，在词条后面加上了一个空格，而且词条后面有空格时也不能更正。

各位高手请看看我在三楼的代码，思路应该没问题，但多个查找怎样循环、文中没有要查找的字符时怎样处理我不懂，另外代码应该可以简化。

[此贴子已经被作者于2005-9-19 11:31:50编辑过]

yuyvtul

我的目的受Word本身的限制，用自动图文集不能解决，各位高手请看看我在三楼的代码，思路应该没问题，但多个查找怎样循环、文中没有要查找的字符时怎样处理我不懂，另外代码应该可以简化。

yuyvtul

急用,各位指教。

要将整篇文档中的指定字符删除，改写成另一带格式的指定字符，有很多这样的。

例如，将“俅”删除，改写为“H2”；将“炻”删除，改写为“H+”……

不能用或调用替换、自动更正、自动图文集功能，必须用查找—删除—改写的方法。

并将光标回到原位置。

我录制了一个宏，但存在一些问题，还有代码简化、怎样循环、没有欲查找的字符时的处理、光标如何回位等问题不知怎么解决。

请各位指教。

Selection.Find.ClearFormatting With Selection.Find .Text = "俅" End With Selection.Find.Execute Selection.TypeText Text:="H2" Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Font.Subscript = wdToggle Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.Font.Subscript = wdToggle End Sub

守柔

你把所有的查找与替换的文本写出来，把格式也写出来，最好列表，并附件上传（一个是带有所有查找/替换内容的原稿，另一个是最终结果的文档），我看一下，有时间的话，很容易实现。

yuyvtul

按守大侠吩咐，将附件上传，谢谢了。

NufYGd6a.rar (45.89 KB, 下载次数: 9)

2005-9-22 23:06 上传

点击文件名下载附件
求VBA代码

守柔

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-9-23 5:07:25 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 00033^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub Test() Dim myString As String, myDoc As Document, i As Range, oCell As Cell Dim PostionNumber As Integer, myRange As Range, Target As Range On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新 '隐藏方式打开指定的更正表文档 Set myDoc = Documents.Open(FileName:="C:\Documents and Settings\My Documents\temp\附件\更正表.Doc", Visible:=False) With myDoc '遍历更正表文档中的表格1中的第一列单元格 For Each oCell In .Tables(1).Columns(1).Cells '取得自造字文本,注意,你的自造字必须为单字,并且不可能会产生词组 myString = myString & .Range(oCell.Range.Start, oCell.Range.End - 1) Next ' Debug.Print myString Set myRange = Me.Content '定义一个RANGE对象 GT: For Each i In myRange.Words '在本文档中遍历各个词 PostionNumber = VBA.InStr(myString, i) '是否存在自造字 If PostionNumber > 0 Then '如果是自造字,根据返回的值,获得相应行号单元格 Set Target = .Range(.Tables(1).Cell(PostionNumber, 2).Range.Start, .Tables(1).Cell(PostionNumber, 2).Range.End - 1) Target.Copy '目标区域复制 i.PasteAndFormat (wdFormatOriginalFormatting) '在当前词位置粘贴/请检查工具/选项/编辑:键入内容替换所选内容前为勾选. Set myRange = Me.Range(i.End, Me.Content.End) '重新定义一个RANGE对象 GoTo GT '转到GT行,重新开始新的循环 End If Next .Close False '关闭更正表文档 End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

[此贴子已经被作者于2005-9-23 5:06:27编辑过]

yuyvtul

早晨好，谢谢。代码看到，不知怎样使用，不懂Option Explicit。是怎样。

“你的自造字必须为单字”——都是单字。

“并且不可能会产生词组”——未明白什么意思，请指教。

提示错误。

[此贴子已经被作者于2005-9-23 7:03:36编辑过]

守柔

其实楼主应该好好看看我的WORDVBA讲座！

请注意代码头，此代码放在THISDOCUMENT类模块的代码窗口中更合适，如果不想，就把ME改为THISDOCUMENT，就可以放到标准模块中了。

如果需要保存，可以这样：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-9-23 07:10:39 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 00033^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub Test() Dim myString As String, myDoc As Document, i As Range, oCell As Cell Dim PostionNumber As Integer, myRange As Range, Target As Range On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新 '隐藏方式打开指定的更正表文档 Set myDoc = Documents.Open(FileName:="C:\Documents and Settings\My Documents\temp\附件\更正表.Doc", Visible:=False) With myDoc '遍历更正表文档中的表格1中的第一列单元格 For Each oCell In .Tables(1).Columns(1).Cells '取得自造字文本,注意,你的自造字必须为单字,并且不可能会产生词组 myString = myString & .Range(oCell.Range.Start, oCell.Range.End - 1) Next ' Debug.Print myString Set myRange = Me.Content '定义一个RANGE对象 GT: For Each i In myRange.Words '在本文档中遍历各个词 PostionNumber = VBA.InStr(myString, i) '是否存在自造字 If PostionNumber > 0 Then '如果是自造字,根据返回的值,获得相应行号单元格 Set Target = .Range(.Tables(1).Cell(PostionNumber, 2).Range.Start, .Tables(1).Cell(PostionNumber, 2).Range.End - 1) Target.Copy '目标区域复制 i.PasteAndFormat (wdFormatOriginalFormatting) '在当前词位置粘贴/请检查工具/选项/编辑:键入内容替换所选内容前为勾选. Set myRange = Me.Range(i.End, Me.Content.End) '重新定义一个RANGE对象 GoTo GT '转到GT行,重新开始新的循环 End If Next .Close False '关闭更正表文档 End With Me.UndoClear '清空撤消 Me.Save '保存 Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

yuyvtul

不好意思，VBA我真的不懂，学习又不是短时间的事。只有模仿，录制宏后更改。

yuyvtul

①水平太低，代码不会用，代码头我不知怎么处理，不是这个代码头我不懂，而是我根本不知“代码头”这个词的意义。。

“此代码放在THISDOCUMENT类模块的代码窗口中更合适”——这句话我也不会用。

“就把ME改为THISDOCUMENT，就可以放到标准模块中了”。改了。大概我还是用错了。

②“注意,你的自造字必须为单字,并且不可能会产生词组”，若意思是两个需要更正的字不能连在一起，则这个代码不能达到我的目的。因为程序的目的就是要将自动更正时，因两个或多个自造字连在一起的情况而未更正的再次更正。