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