图表题注（杜老师已提供指导代码）

wan12327

Sub 表格插入题注()
Dim atable As Table
If ActiveDocument.Tables.Count >= 1 Then
For Each atable In ActiveDocument.Tables
    CaptionLabels.Add Name:="表"
    With CaptionLabels("表")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    End With
   With atable.Range
       .InsertCaption Label:="表", TitleAutoText:="InsertCaption4", Title _
        :="", Position:=wdCaptionPositionAbove, ExcludeLabel:=0
        End With
       With ActiveDocument.Styles("题注")
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
    End With
    Next atable
End If
End Sub


这个是直接在表格上方加题注的代码，但是我还没有实现题注和图表名合在一起。请老师帮忙解决一下。

以下是我的两种思路.

1、想实现在图表名左边直接加题注

2、表名和图名前方有特殊字符，比如     图表题注：表名1
通过定位 “图表题注” 这四个字，在左边或上面插入题注，然后将 “图表题注” 删除

如果老师有更好的思路，就更好了。



这是杜老师的指导代码：（完美地解决了我的问题，非常感谢杜老师的指导）
Sub 插入题注()
    Dim tb As Table, d As Document
    Set d = ActiveDocument
    If d.Tables.Count < 1 Then Exit Sub
    If d.ListParagraphs.Count < 1 Then Exit Sub
    CaptionLabels.Add Name:="表"
    With CaptionLabels("表")
        .NumberStyle = 0
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = 0
    End With
    For Each tb In ActiveDocument.Tables
        With tb.Range.Previous(4, 1)
            .End = .Start
            .InsertCaption Label:="表", Title:="：", ExcludeLabel:=0
            .ParagraphFormat.Alignment = 1
        End With
    Next
End Sub

wan12327

这是杜老师提供的改进方案，非常完美地解决了我的问题，非常感谢杜老师的指导

Sub 插入题注()
    Dim tb As Table, d As Document
    Set d = ActiveDocument
    If d.Tables.Count < 1 Then Exit Sub
    If d.ListParagraphs.Count < 1 Then Exit Sub
    CaptionLabels.Add Name:="表"
    With CaptionLabels("表")
        .NumberStyle = 0
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = 0
    End With
    For Each tb In ActiveDocument.Tables
        With tb.Range.Previous(4, 1)
            .End = .Start
            .InsertCaption Label:="表", Title:="：", ExcludeLabel:=0
            .ParagraphFormat.Alignment = 1
        End With
    Next
End Sub

wan12327

这是图片的题注，在杜老师改进的表格题注的代码上修改的：

Sub 图片题注()
    Dim tb As InlineShape, d As Document
    Set d = ActiveDocument
    If d.InlineShapes.Count < 1 Then Exit Sub
    If d.ListParagraphs.Count < 1 Then Exit Sub
    CaptionLabels.Add Name:="图"
    With CaptionLabels("图")
        .NumberStyle = 0
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = 0
    End With
    For Each tb In ActiveDocument.InlineShapes
        With tb.Range.Next(4, 1)
            .End = .Start
            .InsertCaption Label:="图", Title:="：", ExcludeLabel:=0
            .ParagraphFormat.Alignment = 1
        End With
    Next
End Sub

wdpfox

下载学习，多谢杜老师慷慨分享好代码！
　　　　　　Oooo
　　　　　　(___)
　　oooO  　 )_/
　　(___) 　 (_/
　　 \_(
　　　\_)