Sub Macro13()
'
' Macro13 Macro
'
宏在
2010-7-26
由
陈挺
录制
'
Dim Ting As Integer
For Ting = 0 To 100
Selection.Find.ClearFormatting
With Selection.Find
.Text = "
所示
"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If Not Selection.Find.Execute Then
Exit Sub
End If
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.InsertCaption Label:="
表
", TitleAutoText:="InsertCaption5", Title _
:="", Position:=wdCaptionPositionAbove, ExcludeLabel:=0
Selection.TypeText Text:=" "
ActiveWindow.ActivePane.VerticalPercentScrolled = 2
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine
Selection.MoveLeft Unit:=wdCharacter, Count:=3
Dim myDialog As Dialog, myRef() As String, myLabel As String
Dim CurrentPar As Paragraph, myRange As Range, strText() As String
Dim RefCount As String
On Error GoTo ExitmySub
Set myRange = Selection.Paragraphs(1).Range
myRange.SetRange myRange.End + 1, ActiveDocument.Content.End
With myRange.Find
.Style = "
题注
"
If .Execute = False Then Exit Sub
strText = VBA.Split(myRange.Text, " ")
myLabel = strText(0)
End With
myRef() = ActiveDocument.GetCrossReferenceItems(myLabel) --
放置断点
RefCount = CStr(UBound(myRef))
Selection.InsertCrossReference ReferenceType:=myLabel, ReferenceKind:=wdOnlyLabelAndNumber, ReferenceItem:=RefCount, InsertAsHyperlink:=True
Selection.TypeBackspace
Selection.Font.Size = 12
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Next
ExitmySub:
End Sub