会计准则排版代码

企业会计准则排版VBA代码

Sub 会计准则排版()
    Dim Mypath As String, Delaytime As Double
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = -1 Then Mypath = .SelectedItems(1)
    End With
    Documents.Open FileName:=Mypath
    Selection.WholeStory
    Selection.Copy
    Documents.Add DocumentType:=wdNewBlankDocument
    Delaytime = Now + TimeValue("00:00:01")
    Do
        DoEvents
    Loop While Now < Delaytime    
    Selection.PasteAndFormat (wdFormatPlainText)    
    With Selection.Find
        .Text = "."
        .Replacement.Text = "、"
        .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
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "\n^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        
    With Selection.Find
        .Text = "<第[零一二三四五六七八九十百千]{1,}条>"
        .Replacement.Text = "^&"
        .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        
    With Selection.Find
        .Text = "<第[零一二三四五六七八九十百千]{1,}章>"
        .Replacement.Text = "#### ^&"
        .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                
    Selection.WholeStory
    Selection.Copy
    ActiveDocument.Close (0)
    ActiveDocument.Close (0)
End Sub

会计准则解释排版VBA代码

Sub 会计准则解释排版()
    With Selection.Find
        .Text = "<[一二三四五六七八九十]{1,}、^13"
        .Replacement.Text = "^&^13^13"
        .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
    With Selection.Find
        .Text = "^13\\*^13"
        .Replacement.Text = "^13"
        .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
    With Selection.Find
        .Text = "答：^13"
        .Replacement.Text = "答："
        .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
    With Selection.Find
        .Text = "^13^13答："
        .Replacement.Text = "^13答：** ^13"
        .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
    With Selection.Find
        .Text = "^13"
        .Replacement.Text = "\n^13"
        .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