vba 处理word 的一些代码:修改公式(1--1)为(1-1)



Sub ConvertSpecificEquationsToText()
    Dim oEq As OMath
    Dim eqText As String
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    ' Define the regular expression pattern
    regEx.Pattern = "(\d{1,2}.?\d{1,2})" ' Pattern for (digit?digit)
    regEx.Global = True
    
    ' Loop through each equation in the document
    Dim oMaths As oMaths
    Set oMaths = ActiveDocument.oMaths
    
    Dim i As Long
    Dim p As Paragraph
    Dim tabStop As tabStop
    Dim tabsArray() As Double
    Dim alignsArray() As WdTabAlignment
    Dim leadersArray() As WdTabLeader
    Dim j As Integer
    
    For i = oMaths.Count To 1 Step -1
        Set oEq = oMaths(i)
        eqText = oEq.Range.Text
        ' Debug.Print "Equation Text: " & eqText
        
        ' Check if the equation text matches the pattern
        If regEx.Test(eqText) Then
            ' Store current paragraph's tab stops
            Set p = oEq.Range.Paragraphs(1)
            
            ReDim tabsArray(1 To p.TabStops.Count)
            ReDim alignsArray(1 To p.TabStops.Count)
            ReDim leadersArray(1 To p.TabStops.Count)
            
            For j = 1 To p.TabStops.Count
                Set tabStop = p.TabStops(j)
                tabsArray(j) = tabStop.Position
                alignsArray(j) = tabStop.Alignment
                leadersArray(j) = tabStop.Leader
            Next j
            
            ' Convert the equation to normal text
            oEq.Range.oMaths(1).ConvertToNormalText
            
            ' Apply the "Normal" style
            oEq.Range.Style = wdStyleNormal
            
            ' Restore the tab stops
            p.TabStops.ClearAll
            For j = 1 To UBound(tabsArray)
                p.TabStops.Add Position:=tabsArray(j), Alignment:=alignsArray(j), Leader:=leadersArray(j)
            Next j
            
            Debug.Print "Converted: " & oEq.Range.Text
        End If
    Next i
End Sub




remove the indent of "其中,"

Function CharactersToPoints(para As Paragraph, charCount As Integer) As Single
    Dim rng As Range
    Set rng = para.Range.Duplicate
    
    ' Insert a sample text
    rng.Collapse wdCollapseEnd
    rng.InsertAfter String(charCount, "X")
    rng.Start = rng.End - charCount
    
    ' Get the width of the text in points
    CharactersToPoints = rng.Information(wdHorizontalPositionRelativeToTextBoundary)
    
    ' Remove the sample text
    rng.Text = ""
End Function


Sub RemoveFirstLineIndent()
    Dim para As Paragraph
    Dim searchText As String
    Dim charWidthInPoints As Single
    
    ' Define the search text
    searchText = "其中,"
    
    ' Loop through each paragraph in the document
    For Each para In ActiveDocument.Paragraphs
        ' Check if the paragraph contains the specific text within the first few characters
        If InStr(1, para.Range.Text, searchText, vbTextCompare) = 1 Then
            ' Calculate the character width in points
            charWidthInPoints = CharactersToPoints(para, 2)
            
            ' Decrease the left indent by 2 characters
            para.LeftIndent = para.LeftIndent - charWidthInPoints
        End If
    Next para
End Sub

replace 1-1-1 sections to 1.1.1 section

Sub ReplaceSectionNumbers()
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        If para.Style = ActiveDocument.Styles("标题 1").NameLocal Or _
           para.Style = ActiveDocument.Styles("标题 2").NameLocal Or _
           para.Style = ActiveDocument.Styles("标题 3").NameLocal Or _
           para.Style = ActiveDocument.Styles("标题 4").NameLocal Then

            Dim range As range
            Set range = para.range
            
            Dim text As String
            text = range.text
            
            Dim spacePos As Long
            spacePos = InStr(text, " ")
            
            If spacePos > 0 Then
                Dim firstPart As String
                firstPart = Left(text, spacePos - 1)
                
                If IsSectionNumber(firstPart) Then
                    Dim replaceText As String
                    replaceText = Replace(firstPart, "-", ".")
                    
                    ' Calculate the start position of the section number
                    range.Start = para.range.Start
                    
                    ' Calculate the end position of the section number
                    range.End = range.Start + Len(replaceText)
                    
                    ' Replace the section number text
                    range.text = replaceText
                End If
            End If
        End If
    Next para
End Sub

Function IsSectionNumber(s As String) As Boolean
    Dim parts() As String
    parts = Split(s, "-")
    
    If UBound(parts) > 0 Then
        Dim i As Long
        For i = 0 To UBound(parts)
            If Not IsNumeric(parts(i)) Then
                IsSectionNumber = False
                Exit Function
            End If
        Next i
        
        IsSectionNumber = True
    Else
        IsSectionNumber = False
    End If
End Function
posted @ 2023-10-29 15:12  ChrainY  阅读(67)  评论(0编辑  收藏  举报