|
斑竹,按你的程序改了一下,千辛万苦编好了,运行不了,说是禁用宏了,看它的帮助也不知道该怎么处理?斑竹帮帮我.另外也帮我看看程序有没有问题,昨天到今天看了两天帮助了,我这是第一次编写word中的程序,照猫画虎还不得要领,请斑竹千万帮帮我.
附上数据文档处理后要求的标准文档和原文档.
在标准文档中,
1 每个数据有7项 (不包括标题,每个标题前有标号).
(项目名分别为:Official Symbol, Name, Other Aliases, Other Designations, Chromosome, Location, GeneID)
2 在原数据中Name项通常在Official Symbol中.处理时去掉and另起一行
3 在原数据中有些项是缺失的,处理时用空行代替.(见标准文档)
4 在例文档中的最后一项比较特殊,见标准文档中的处理.
附源程序:(又按斑竹的程序修改了,但还有错,高手们帮我看看呀)
Sub datwork()
Dim i As Paragraph, n As Long, m As Long
Dim myrange As Range
Set doc = ActiveDocument
Application.ScreenUpdating = False '关闭屏幕刷新
'===========================
For Each i In doc.Paragraphs '在活动文档的段落集合中循环
If Len(i.Range) = 1 Then '判断段落长段,此处可根据文档实际情况
i.Range.Delete '进行必要的修改可将任意长度段落删除
End If
Next
'===========================
With doc.Content.Find '替换:去掉and另起一行
.ClearFormatting
.Text = "and"
.Replacement.ClearFormatting
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
'===========================
With doc.Content.Find '替换,使Location另起一行
.ClearFormatting
.Text = "Location"
.Replacement.ClearFormatting
.Replacement.Text = "^pLocation"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
'===========================
For Each i In doc.Paragraphs '在活动文档的段落集合中循环
If VBA.InStr(i.Range, "Links") <> 0 Then
If (n = 7) Then
i.Range.InsertBefore Text = Chr(13)
End If
n = 1
m = m + 1
End If
myrange = i.Range.Words(1) & " " & i.Range.Words(2) '<此处有问题
If (n = 1) And (myrange <> "Official Symbol") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
If (n = 3) And (myrange <> "Other Aliases") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
If (n = 4) And (myrange <> "Other Designations") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
myrange = i.Range.Words(1)
If (n = 2) And (myrange <> "Name") And (myrange <> "similar") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
If (n = 5) And (myrange <> "Chromosome") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
If (n = 6) And (myrange <> "Location") Then
n = n + 1
i.Range.InsertBefore Text = Chr(13)
End If
Next
'============================
MsgBox "共有" & m & "个数据!"
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub
N3vc6uhb.rar
(4.44 KB, 下载次数: 17)
[此贴子已经被作者于2005-8-13 0:04:19编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-8-12 17:21
楼主