VBA-WORD插入字幕,而不附加到现有字幕

时间:2019-02-08 00:30:07

标签: vba ms-word

我正在尝试创建一个宏,该宏可以单独识别Word文档中的内联形状和表格,以便可以创建标题。

我遇到了麻烦:

如果文档已经在inlineshapes(或其他可能具有标题的对象)下输入了标题,它会添加其他标题,并且不添加之前输入的标题名称,它只是将其添加为图1, Figure2,Figure3等。我无法插入名称作为标题。

Sub ApplyCaptions()
Application.ScreenUpdating = True
Dim oCap As CaptionLabel, bCap As Boolean, iShp As InlineShape, oTbl As Table, TmpRng As Range
With ActiveDocument
  For Each iShp In .InlineShapes
    Set TmpRng = iShp.Range.Paragraphs.First.Range
    With TmpRng
      If .Style = "Caption" Then bCap = ChkCaption(TmpRng)
      If .Paragraphs.Last.Next.Range.Style = "Caption" And bCap = False Then
        bCap = ChkCaption(TmpRng)
      End If
      If bCap = False Then
        iShp.Range.InsertCaption Label:="Figure", TitleAutoText:="", _
          Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
      End If
    End With
  Next
  For Each oTbl In .Tables
    Set TmpRng = oTbl.Range.Paragraphs.Last.Range
    With TmpRng
      If .Style = "Caption" Then bCap = ChkCaption(TmpRng)
      If .Paragraphs.Last.Next.Range.Style = "Caption" And bCap = False Then
        bCap = ChkCaption(TmpRng)
      End If
      If bCap = False Then
        oTbl.Range.InsertCaption Label:="Table", TitleAutoText:="", _
          Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
      End If
    End With
  Next
End With
Set TmpRng = Nothing
Application.ScreenUpdating = False
End Sub

Function ChkCaption(TmpRng As Range) As Boolean
Dim oCap As CaptionLabel
ChkCaption = False
For Each oCap In CaptionLabels
  If InStr(TmpRng.Text, CaptionLabels(oCap)) > 0 Then
    ChkCaption = True
    Exit For
  End If
Next
End Function

0 个答案:

没有答案