以指定字符重新划分段落并插入时间序列数(VBA)

Sub CreateParagraph()
Dim I As Long, N As Integer
On Error Resume Next    '忽略错误
Application.ScreenUpdating = False    '关闭屏幕更新
With ActiveDocument
'将文档中所有段落标记删除
.Content.Find.Execute FindText:="^p", ReplaceWith:="",
Replace:=wdReplaceAll
For I = 0 To .Content.End Step 10    '以 10 个字符位置(包括非打印字符)为
步长循环
'每段十个字符部分分成段落(注意插入的段落标记也是一个字符)
.Range(I, I + 10 + N).InsertAfter Chr(13)
N = N + 1    '计算插处的段落标记个数
Next
End With
Application.ScreenUpdating = True    '恢复屏幕更新
InsertTimer
End Sub
'----------------------
Sub InsertTimer()
Dim I As Paragraph, N As Integer, TimeStr As String
On Error Resume Next    '忽略错误
Application.ScreenUpdating = False    '关闭屏幕更新

For Each I In ActiveDocument.Paragraphs    '在文档新的段落中循环
If N < 10 Then    '<10,TimeStr的分钟值为 5(保持两位数 05)
TimeStr = "[00:0" & N & ".00]"
ElseIf N = 60 Then    'N=60时时间数进一并保持该数据(不再向上)
TimeStr = "[01:00.00]"
N = 0
Else    'TimeStr的分钟数照计(两位数)
TimeStr = "[00:" & N & ".00]"
End If
I.Range.InsertBefore TimeStr    '每个段前插入时间数值
N = N + 5    '以 5 为步长累加
Next
Application.ScreenUpdating = True    '恢复屏幕更新
End Sub