vbaword编号

如何用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

Excel VBA如何去掉WORD中的全部自动编号的格式,但数字还保留着-

备份文件后应用如下宏（用法：如果有选择则处理选择区域，否则处理全部）：Sub 自动编号转文本（） If Selection.Type = wdSelectionIP Then ActiveDocument.Content.ListFormat.ConvertNumbersToText ActiveDocument.Content.Find.Execute FindText:="^t", replacewith:=" ", Replace:=wdReplaceAll Else Selection.Range.ListFormat.ConvertNumbersToText Selection.Find.Execute FindText:="^t", replacewith:=" ", Replace:=wdReplaceAll End IfEnd Sub。

word自动编号怎么实现先写带有编号的内容,然后在加一页目录,把

你的问题，可用自动生成目录解决.要想自动生成题目，打文件时应设置题目格式。

一、输入题目时这样操作 1、打开WORD文档输入题目时，点菜单字体栏左侧样式窗口，选“题目1”，并选好字体和字号；如果想在目录中显示二级题目，输入二级题目时应选择“题目2”。 2、输入正文时，则应在样式窗口选择“正文”。

3、如果文件已经输入完成，可选中已输好题目，补做上述方法1程序。 4、凡设置标题样式的题目，其左侧有小黑方块标志。

二、文件输入完毕要自动生成目录时的操作： 1、将光标置于拟加目录处。 2、点“插入/索引和目录/目录”，在出现界面上在显示级别栏选定顶级别确定目录是几层；选择“显示页码”、“页码右对齐”及虚线样式等。

3、确定。至此，目录在你指定位置已经生成。

三、已生成目录的字体、间距等仍可以在目录中直接调整。

用VBA将杂乱WORD段落的重新编号

这种情况其实不需要VBA就能实现，主要用到Word的高级替换技巧就行，可按下面的步骤操作（注：演示版本为Word2016）: 1.按Ctrl+F9产生一对{}，并在双括号内输入AutoNum后按F9，选中这个特殊字符（域）并复制或剪切到剪贴板。

2.调出替换界面→点击更多→选中使用通配符，并在查找框中输入（^13）([0-9]@[！一-龥]@)（[一-龥]）在替换框输入\1^c. \3后点击全部替换。 3.分析部分段落开始只有数字字符的情况，可再调出替换界面，仍然选中使用通配符，在查找框中输入（^13）([0-9]@)（[一-龥]）在替换框输入\1^c. \3后点击全部替换。

4.全选→按F9更新域，再按Ctrl+Shift+F9将域转为普通字符即可完成。 全部操作见下图演示： 。

Excel VBA如何去掉WORD中的全部自动编号的格式,但数字还保留着

备份文件后应用如下宏（用法：如果有选择则处理选择区域，否则处理全部）：

Sub 自动编号转文本（）

If Selection.Type = wdSelectionIP Then

ActiveDocument.Content.ListFormat.ConvertNumbersToText

ActiveDocument.Content.Find.Execute FindText:="^t", replacewith:=" ", Replace:=wdReplaceAll

Else

Selection.Range.ListFormat.ConvertNumbersToText

Selection.Find.Execute FindText:="^t", replacewith:=" ", Replace:=wdReplaceAll

End If

End Sub

word vba如何批量复制表格并编号

下面这段代码是实现将excel表格插入到指定word模板的指定位置。

可以参考一下。Sub 插入表格（）Dim SS As StringDim wdoc As New Word.ApplicationDim 当前路径， 导出路径文件名， i, jDim Str1, Str2, Str3Dim tarr(1 To 100, 1 To 3)Dim filepathname As String当前路径 = ThisWorkbook.Path最后行号 = Sheets（"数字表格"）.Range("B30").End(xlUp).Row判断 = 0' 导出文件名 = "报告作品.doc"filepathname = 当前路径 & "\" & TfileIf Dir(filepathname) = "" Then'文件不存在FileCopy 当前路径 & "\" & Sfile， 当前路径 & "\" & TfileEnd IfSheets（"数字表格"）.SelectFor i = KShh To 最后行号tarr(i - KShh + 1, 1) = Sheets（"数字表格"）.Cells(i, 1)tarr(i - KShh + 1, 2) = Sheets（"数字表格"）.Cells(i, 2)tarr(i - KShh + 1, 3) = Sheets（"数字表格"）.Cells(i, 3)Next ij = i - KShh '记录需替换文本个数导出路径文件名 = 当前路径 & "\" & TfileWith wdoc '打开word文档.Documents.Open 导出路径文件名.Visible = TrueEnd WithFor i = 1 To jStr1 = tarr(i, 1)Str2 = tarr(i, 2)Str3 = tarr(i, 3)Range(Str3).SelectApplication.CutCopyMode = FalseSelection.CopyWith wdoc.Selection.HomeKey Unit:=wdStory '光标置于文件首If .Selection.Find.Execute(Str1) Then '查找到指定字符串.Selection.Text = "" '替换字符串.Selection.PasteExcelTable False, False, False '粘贴为表格.Selection.WholeStory.Selection.Font.Size = 12With .Options.DefaultBorderLineStyle = wdLineStyleSingle.DefaultBorderLineWidth = wdLineWidth050pt.DefaultBorderColor = wdColorAutomaticEnd With.Selection.Tables(1).PreferredWidthType = 3.Selection.Tables(1).PreferredWidth = .CentimetersToPoints(15)End If' wdoc.Documents.Save' wdoc.Quit' Set wdoc = NothingEnd WithNext iWith wdoc '存盘后关闭WORD文档wdoc.Documents.Savewdoc.QuitSet wdoc = NothingEnd WithSheets（"首页"）.SelectEnd Sub。

word的宏编码问题要求：将一个文件夹里的所有WORD文件（当然 爱

丑丑，你好！你需要的代码如下，打开word，执行复制以下宏代码（首尾Sub Macro1(),End Sub是重复的，不用复制），按快捷键Alt+F11，切换到Visual Basic 编辑器，粘贴代码即可！ Sub Macro1() Application。

DisplayStatusBar = True Application。ShowWindowsInTaskbar = True Application。

ShowStartupDialog = True With ActiveWindow 。 DisplayHorizontalScrollBar = True 。

DisplayVerticalScrollBar = True 。DisplayLeftScrollBar = False 。

StyleAreaWidth = CentimetersToPoints(0) 。DisplayVerticalRuler = True 。

DisplayRightRuler = False 。 DisplayScreenTips = True With 。

View 。ShowAnimation = True 。

Draft = False 。 WrapToWindow = False 。

ShowPicturePlaceHolders = False 。ShowFieldCodes = False 。

ShowBookmarks = False 。 FieldShading = wdFieldShadingWhenSelected 。

ShowTabs = False 。ShowSpaces = False 。

ShowParagraphs = True 。 ShowHyphens = False 。

ShowHiddenText = False 。ShowAll = True 。

ShowDrawings = True 。 ShowObjectAnchors = False 。

ShowTextBoundaries = False 。ShowHighlight = True 。

ShowOptionalBreaks = False 。 DisplayPageBoundaries = True 。

DisplaySmartTags = True End With End With With Options 。 Pagination = True 。

WPHelp = False 。WPDocNavKeys = False 。

ShortMenuNames = False 。RTFInClipboard = True 。

BlueScreen = False 。EnableSound = False 。

ConfirmConversions = False 。UpdateLinksAtOpen = True 。

SendMailAttach = True 。MeasurementUnit = wdMillimeters 。

AllowPixelUnits = False 。UseCharacterUnit = True 。

AllowReadingMode = True 。AnimateScreenMovements = True 。

VirusProtection = False 。ApplyFarEastFontsToAscii = False 。

InterpretHighAnsi = wdAutoDetectHighAnsiFarEast 。BackgroundOpen = False 。

AutoCreateNewDrawings = True End With Application。 DisplayRecentFiles = True RecentFiles。

Maximum = 4 With ActiveDocument。Styles(wdStyleNormal)。

Font If 。NameFarEast = 。

NameAscii Then 。NameAscii = "" End If 。

NameFarEast = "" End With With ActiveDocument。 PageSetup 。

LineNumbering。Active = False 。

Orientation = wdOrientPortrait 。TopMargin = MillimetersToPoints(25。

4) 。BottomMargin = MillimetersToPoints(25。

4) 。LeftMargin = MillimetersToPoints(20) 。

RightMargin = MillimetersToPoints(20) 。 Gutter = MillimetersToPoints(10) 。

HeaderDistance = MillimetersToPoints(17) 。FooterDistance = MillimetersToPoints(20) 。

PageWidth = MillimetersToPoints(210) 。PageHeight = MillimetersToPoints(297) 。

FirstPageTray = wdPrinterDefaultBin 。 OtherPagesTray = wdPrinterDefaultBin 。

SectionStart = wdSectionNewPage 。OddAndEvenPagesHeaderFooter = False 。

DifferentFirstPageHeaderFooter = False 。VerticalAlignment = wdAlignVerticalTop 。

SuppressEndnotes = False 。 MirrorMargins = False 。

TwoPagesOnOne = False 。BookFoldPrinting = False 。

BookFoldRevPrinting = False 。 BookFoldPrintingSheets = 1 。

GutterPos = wdGutterPosLeft 。LayoutMode = wdLayoutModeLineGrid End With With Selection。

ParagraphFormat 。LeftIndent = MillimetersToPoints(0) 。

RightIndent = MillimetersToPoints(0) 。SpaceBefore = 0 。

SpaceBeforeAuto = False 。SpaceAfter = 0 。

SpaceAfterAuto = False 。LineSpacingRule = wdLineSpaceExactly 。

LineSpacing = 20 。Alignment = wdAlignParagraphJustify 。

WidowControl = False 。KeepWithNext = False 。

KeepTogether = False 。PageBreakBefore = False 。

NoLineNumber = False 。Hyphenation = True 。

FirstLineIndent = MillimetersToPoints(0) 。OutlineLevel = wdOutlineLevelBodyText 。

CharacterUnitLeftIndent = 0 。 CharacterUnitRightIndent = 0 。

CharacterUnitFirstLineIndent = 0 。LineUnitBefore = 0 。

LineUnitAfter = 0 。 AutoAdjustRightIndent = True 。

DisableLineHeightGrid = False 。FarEastLineBreakControl = True 。

WordWrap = True 。 HangingPunctuation = True 。

HalfWidthPunctuationOnTopOfLine = False 。AddSpaceBetweenFarEastAndAlpha = True 。

AddSpaceBetweenFarEastAndDigit = True 。BaseLineAlignment = wdBaselineAlignAuto End With Selection。

Font。 Color = wdColorBlack End Sub 祝你成功，请见附件：。

根据情况自动编号的VBA代码详情请见附件

既然可以使用公式，单元格公式运算速度远快于VBA，不一定就要用VBA。

当然，使用VBA实现完全没问题。 见下面的宏： Sub 编号（） Cells(2, 3) = Val(Cells(2, 3)） '防错：班级如为字符转为数字 Cells(2, 5) = (Cells(2, 3) \ 10) * 100 + 1 '第一位赋初值 For i = 3 To 12 '从第二位开始 Cells(i, 3) = Val(Cells(i, 3)） '防错：转为数字 NJ = Cells(i, 3) \ 10 '提取年级 M = 0 '同姓名人数，初值=0 For j = 2 To i - 1 '向前检查 If (Cells(j, 3) \ 10) = NJ Then '年级相同？ If Cells(i, 2) = Cells(j, 2) Then'姓名相同？ Cells(i, 5) = Cells(j, 5) '年级、姓名都相同：复制编号 Exit For '退出→下一位 Else '年级相同、姓名不相同 '记录不同姓名数 If (Cells(j, 5) Mod 10) > M Then M = (Cells(j, 5) Mod 10) End If End If Next j Cells(i, 5) = NJ * 100 + M + 1 '添加编号（=不同姓名数+1） Next i End Sub。

转载请注明出处51数据库 » vbaword编号