墨镜不懂夜的黑
如何用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。
