QQ聊天记录格式化的word宏

常用Word通配符替换

去掉QQ号：通配符：\([0-9]{5,10}\)
老师发言：<老师 {1,}[0-9]{1,2}:[0-9]{2}:[0-9]{2}>
时间格式：<[0-9]{1,2}:[0-9]{2}:[0-9]{2}>
网页换行(^l)转回车(^p)

'word宏开始

Sub QQ2010聊天记录格式整理()
'QQ2010版聊天记录处理

Dim ps As Paragraph
Dim s As Paragraph
Dim allps As Paragraphs
Set allps = ActiveDocument.Paragraphs
 

Call  删除所有qq号

'1：整体变换网页换行^1与word中回车^p
Call 网页换行改成回车

'2：老师姓名加红

'老师为发言人段标识符
Dim isTeacher
isTeacher = False
'道友为发言人标识符
Dim isSayer
isSayer = False
'普通段落标识符
Dim isParag
isParag = True

For Each ps In allps
    With ps.Range.Find
        .Text = "<[0-9]{1,2}:[0-9]{2}:[0-9]{2}>"
        .Forward = True
        .MatchWildcards = True
        .Execute
        
        If .Found = True Then
            '这种格式为发言人格式段落
            isSayer = True
            isTeacher = False
            isParag = False
            '以12:23:56这样的时间格式结尾
            ps.Range.Select
            
            If Left(ps.Range.Text, Len(t)) = t Then
                '老师为发言人
                isTeacher = True
            End If
            'With ps.Range.Find
             '   .Text = t
             '   .Forward = True
             '   .Execute
             '   If .Found = True Then
             '       '老师为发言人
             '       isTeacher = True
             '   End If
            'End With

        Else
            '普通段落
            isSayer = False
            isParag = True
        End If
    End With '查找12:23:56这样的时间格式结尾
    
    If isTeacher = True Then
        ps.Range.Font.color = wdColorRed
    ElseIf isSayer = True Then
        ps.Range.Font.color = wdColorBlue
    End If
Next

'3：时间字体变灰
Call 时间字体变成灰色

End Sub

Sub 网页换行改成回车()
'
' 第一步
' 网页换行改成回车
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub 时间字体变成灰色()
'
' 时间字体变成灰色 Macro
' 12:26:36是时间格式，通配符为<[0-9]{2}:[0-9]{2}:[0-9]{2}>，字体颜色改成灰色
'
    ActiveWindow.ActivePane.VerticalPercentScrolled = 35
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "<[0-9]{1,2}:[0-9]{2}:[0-9]{2}>"
        .Replacement.Font.color = wdColorGray50
        
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

Sub 删除所有qq号()
    ActiveWindow.ActivePane.VerticalPercentScrolled = 35
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\([0-9]{5,10}\)"
        .Replacement.Font.color = wdColorGray50
        
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

'word宏结束