今晚打老虎-_-
一、在word中使用VBA区分标题和正文
获取标题与正文使用style。试验一下如下代码。
Sub Test()
Dim i As Single
For i = 1 To ActiveDocument.BuiltInDocumentProperties(wdPropertyLines).Value
With Selection
.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=i
.HomeKey Unit:=wdLine
.EndKey Unit:=wdLine, Extend:=wdExtend
End With
If Selection.Style = "正文" Then
MsgBox i &； "行是正文"
End If
If Selection.Style = "标题 1" Then
MsgBox i &； "行是标题 1"
End If
Next
End Sub
二、如何用VBA取得Word文档中的标题前面的序号
Sub test()
Dim myRange As Range
Dim num as String, title as String
'Set ps = Selection.Bookmarks("\headinglevel").Range.Paragraphs
Set ps = ActiveDocument.Bookmarks("\headinglevel").Range.Paragraphs
For Each p In ps
Set myRange = p.Range
num = myRange.ListFormat.ListString
title = myRange.Text
MsgBox "编号：" & num & vbCrLf & "标题内容：" & title
Next p
'Set myRange = Selection.Bookmarks("\headinglevel").Range.Paragraphs(1).Range
'MsgBox "编号：" & myRange.ListFormat.ListString & vbCrLf & "标题内容：" & myRange.Text
End Sub
另外附上一段把标题（Heading）序号取出并附加在标题内容后面的代码：
Sub ReplaceHeadingContent()
Dim myRange As Word.Range
Dim num As String, content As String
'取得所有书签
Set ps = ActiveDocument.Bookmarks("\headinglevel").Range.Paragraphs
'对书签中每一个段落进行处理
For Each p In ps
Set myRange = p.Range
With myRange
'把Range结束范围往前移一个字符，目的是为了不包括换行符
.MoveEnd Unit:=wdWord, Count:=-1
'取出段落序号
num = Trim(.ListFormat.ListString)
'取出Heading的内容
content = Trim(.Text)
'如果段落序号不为空，则把段落序号取出附加的标题内容后面
If Trim(num) "" Then
If num = "1.1.1.1.1." Or num = "1.1.1.1.1" Then
MsgBox "到目标点了。"
End If
If Right(num, 1) = "." Then num = Left(num, Len(num) - 1） '不需段落序号最后面的“.”
.Text = content & ""
End If
'MsgBox "编号：" & num & vbCrLf & "标题内容：" & content
End With
Next p
End Sub
三、在word中使用VBA区分标题和正文
获取标题与正文使用style。
试验一下如下代码。 Sub Test()Dim i As SingleFor i = 1 To ActiveDocument.BuiltInDocumentProperties(wdPropertyLines).ValueWith Selection .GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=i .HomeKey Unit:=wdLine .EndKey Unit:=wdLine, Extend:=wdExtendEnd WithIf Selection.Style = "正文" ThenMsgBox i & "行是正文"End IfIf Selection.Style = "标题 1" ThenMsgBox i & "行是标题 1"End IfNextEnd Sub。
四、如何利用VBA批量提取文件夹下所有Word文档的标题和指定段落
Sub test()
Dim fso, fp, arr, wd, f, n%, fname$
Set fso = CreateObject("scripting.filesystemobject")
Set fp = fso.getfolder(ThisWorkbook.Path)
ReDim arr(1 To fp.Files.Count, 1 To 2)
arr(1, 1) = "文件号"： arr(1, 2) = "标题"
Set wd = CreateObject("word.application")
n = 1
For Each f In fp.Files
If Right(f, 3) = "doc" Or Right(f, 4) = "docx" Then
n = n + 1: arr(n, 1) = fso.getbasename(f)
fname = fso.getfilename(f)
With wd.Documents.Open(ThisWorkbook.Path & "\" & fname, True, True)
wd.Visible = True
arr(n, 2) = .Paragraphs(2).Range
.Close
End With
End If
Next
wd.Quit
Sheets(1).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
现在有一个文件夹下有N个Word文件，要将他们的文件名和文档内的第二段提取到Excel表格，如何通过VBA实现
五、如何用VBA设置WORD文档的题目（即第一段）的格式
Sub 宏1()
Dim str As String, i As Integer, j As Integer
j = 0
str = Application.ActiveDocument.Paragraphs(1).Range.Text
For i = 1 To Len(str)
If Mid(str, i, 1) = " " Then
Else
Exit For
End If
j = j + 1
Next
str = Right(str, Len(str) - j)
Application.ActiveDocument.Paragraphs(1).Range.Text = str
Application.ActiveDocument.Paragraphs(1).Range.Select
Selection.Font.Name = "黑体"
Selection.Font.Size = 18
Selection.Font.Bold = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End Sub
六、VBA如何遍历WORD文档中的某一级标题
使用Find方法，看看是不是快了。
'样式、符合样式的当前段文本
Dim wdSty$, strTxt$
wdSty = "标题 1"
With Selection
.HomeKey unit:=wdStory, Extend:=wdMove'光标移到文档首
.Find.ClearFormatting
.Find.Style = ActiveDocument.Styles(wdSty)'设置查找文本的样式为wdSty（“标题1”）
End With
'循环查找文档里所有为“标题1”样式的段落，
Do While Selection.Find.Execute(findtext:="*^13", MatchWildcards:=True, Format:=True)
strTxt = Selection.Text '获取符合样式的文本
'。。.在这里录入处理代码
Selection.Move unit:=wdWord, Count:=1
If Selection.MoveRight <> 1 Then'文档尾退出
Exit Do
Else
Selection.MoveLeft
End If
Loop
七、如何利用VBA批量提取文件夹下所有Word文档的标题和指定段落
Sub test() Dim fso, fp, arr, wd, f, n%, fname$ Set fso = CreateObject("scripting.filesystemobject") Set fp = fso.getfolder(ThisWorkbook.Path) ReDim arr(1 To fp.Files.Count, 1 To 2) arr(1, 1) = "文件号"： arr(1, 2) = "标题" Set wd = CreateObject("word.application") n = 1 For Each f In fp.Files If Right(f, 3) = "doc" Or Right(f, 4) = "docx" Then n = n + 1: arr(n, 1) = fso.getbasename(f) fname = fso.getfilename(f) With wd.Documents.Open(ThisWorkbook.Path & "\" & fname, True, True) wd.Visible = True arr(n, 2) = .Paragraphs(2).Range .Close End With End If Next wd.Quit Sheets(1).[a1].Resize(UBound(arr), UBound(arr, 2)) = arrEnd Sub现在有一个文件夹下有N个Word文件，要将他们的文件名和文档内的第二段提取到Excel表格，如何通过VBA实现。
八、Word用VBA或宏时,怎样获取当前位置所处的标题文本
SubExample()DimmyObjectAsObject'对于浮动式文本框控件SetmyObject=ActiveDocument.Shapes(1).OLEFormat.ObjectMsgBoxmyObject.Text'对于嵌入式文本框控件SetmyObject=ActiveDocument.InlineShapes(1).OLEFormat.ObjectMsgBoxmyObject.Text'对于word的文本框图形（非控件）SetmyObject=ActiveDocument.Shapes(1).TextFrame.TextRangeMsgBoxmyObject.TextEndSub。
九、VBA如何遍历WORD文档中的某一级标题
使用Find方法，看看是不是快了。
'样式、符合样式的当前段文本 Dim wdSty$, strTxt$ wdSty = "标题 1" With Selection .HomeKey unit:=wdStory, Extend:=wdMove'光标移到文档首 .Find.ClearFormatting .Find.Style = ActiveDocument.Styles(wdSty)'设置查找文本的样式为wdSty（“标题1”） End With'循环查找文档里所有为“标题1”样式的段落， Do While Selection.Find.Execute(findtext:="*^13", MatchWildcards:=True, Format:=True) strTxt = Selection.Text '获取符合样式的文本 '。
.在这里录入处理代码 Selection.Move unit:=wdWord, Count:=1 If Selection.MoveRight <> 1 Then'文档尾退出 Exit Do Else Selection.MoveLeft End If Loop。
转载请注明出处51数据库 » word标题列表vba
