office的开发高手们，请进。kankan 谁牛
请问以下想法是否可以实现? 如果用手工的办法，耗时过于巨大，我想用word的提供的宏来实现，需要参考一些那方面的书。要是实现简单，能否提供一些代码？
文档的第三级标题下的内容提取为一个文件，文件名称为第三级标题的开头数字部分。
如：文档一部分
问题点数：0、回复次数：5Top
1 楼vansoft（Vansoft Workroom）回复于 2004-12-06 10:24:12 得分 0
可以，如果有需要，我可以给你写。
交流MSN：van_flf@hotmail.comTop
2 楼yizia（椅子）回复于 2004-12-06 14:10:45 得分 0
简单，把word另存为html，然后你看看什么东西可以自由定位？
他就是超连接，word中的书签Top
3 楼ty_yxl（ty_yxl）回复于 2004-12-23 20:07:53 得分 0
Private Sub Fileout2()
'异常处理：
On Error GoTo ErrHandle
'当前没有打开的文档：
If Documents.Count < 1 Then
MsgBox "请先打开一个文档 ！"
Exit Sub
End If
'不显示修订：
ActiveDocument.ShowRevisions = False
'开始导出文档
Dim iPageStart As Integer
Dim iPageCount As Integer '总页数。
Dim bPart As Boolean
Dim ThisDoc As Document
Dim NewDoc As Document
Dim Title As String
Dim strtemp As String
Dim strtext As String
Dim slen As Integer
Dim rlen As Integer
bPart = False
Set ThisDoc = ActiveDocument
iPageCount = ThisDoc.Paragraphs.Count
iPageStart = 1
While (iPageStart <= iPageCount)
If Not (ThisDoc.Paragraphs(iPageStart).Style Is Nothing) _
And Trim(Replace(ThisDoc.Paragraphs(iPageStart).Range.Text, Chr(13), "")) <> "" Then
If InStr(1, ThisDoc.Paragraphs(iPageStart).Style, "标题 3") <> 0 Then
If bPart Then
NewDoc.SaveAs FileName:=Title, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
NewDoc.Close
End If
Documents.Add Template:="Normal.dot", NewTemplate:=False, DocumentType:=0
Set NewDoc = ActiveDocument
strtext = ThisDoc.Paragraphs(iPageStart).Range.Text
Title = strtext
'Selection.Style
'去数字部分为标题
If InStr(1, strtext, "[") <> 0 Then
slen = InStr(1, strtext, "[")
Else
slen = 0
End If
If slen > 1 Then
Title = Left(strtext, slen - 1)
End If
Title = Title + ".doc"
Selection.Font.Name = "MS SAN SERIF"
Selection.Font.Size = 14
Selection.Font.Bold = 1
rlen = InStr(1, strtext, "]")
If rlen <> 0 Then
strtext = Mid(strtext, slen + 1, rlen - slen - 1) + Right(strtext, Len(strtext) - rlen)
End If
Selection.TypeText Text:=strtext
bPart = True
GoTo loopHandle
End If
If InStr(1, ThisDoc.Paragraphs(iPageStart).Style, "标题 2") <> 0 _
Or InStr(1, ThisDoc.Paragraphs(iPageStart).Style, "标题 1") <> 0 Then
If bPart Then
NewDoc.SaveAs FileName:=Title, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
NewDoc.Close
bPart = False
End If
GoTo loopHandle
End If
If Not bPart Then
GoTo loopHandle
End If
strtext = ThisDoc.Paragraphs(iPageStart).Range.Text
Selection.Font.Name = "MS SAN SERIF"
Selection.Font.Size = 10
Selection.Font.Bold = 0
Selection.TypeText Text:=strtext
End If
loopHandle:
iPageStart = iPageStart + 1
Wend
If bPart Then
NewDoc.SaveAs FileName:=Title, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
NewDoc.Close
End If
Exit Sub
ErrHandle:
MsgBox "检查文档失败， #" + CStr(Err.Number) + "，" + Err.Description + "” ！"
End Sub
Top
4 楼ty_yxl（ty_yxl）回复于 2004-12-23 20:08:06 得分 0
给大家参考Top
5 楼yq3woaini（哈哈镜 选择好心情）回复于 2004-12-29 19:04:29 得分 0
klTop
