word标题列表vba

一、在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