DalomWiki

Funktionskrav:

Ändra indexmarkeringar på formen: { XE “EN 789”} till: { XE “EN 789;0789”}

Dvs lägga till ett sorteringsvärde för varje indexmarkering och padda ut det till fyra siffror.

Dagens ickeoptade funktion:

Sub EnhanceIndexEntries()
  Dim doc As Document
  Dim fld As Field
  Dim temp As String
  Dim temp2 As String
  Dim omsg As String
  Dim matches
  Dim re2, re3 As RegExp
  Set re2 = New RegExp
  Set re3 = New RegExp
  re2.Global = False
  re3.Global = False
  re2.Pattern = "\s([0-9]{2})\W"
  re3.Pattern = "\s([0-9]{3})\W"
 
  Dim cnt As Integer
  cnt = 0
 
  Set doc = ActiveDocument
  For Each fld In doc.Fields
    fld.Select
    If fld.Type = wdFieldIndexEntry Then
        cnt = cnt + 1
        temp = fld.Code
        temp2 = re2.Replace(temp, " $1;00$1" & Chr$(34))
        temp3 = re3.Replace(temp2, " $1;0$1" & Chr$(34))
        With Selection.Find
            .Text = temp
            .Replacement.Text = temp3
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .Execute Replace:=wdReplaceAll
        End With
    End If
  Next
  Set fld = Nothing
  Set doc = Nothing
  omsg = "Justering av indexeringsinformation klar."
  MsgBox (omgs & cnt)
End Sub

Exempel på paddingfunktion, skrivet i det närliggande språket JScript. Nej, det är inte riktigt javascript.

function padNumber(number,size){
	number = new Number(number);
	size = parseInt(size);
	if(isNaN(size) || isNaN(number)) return number+"";
	if(number < Math.pow(10,size)){
		number+=Math.pow(10,size);
		return (number+"").substring(1);
	}else{
		return number+"";
	}
}

Halvoptad kod, går ~dubbelt så snabbt som den ooptade:

Sub NewEnhanceIndexEntries()
  Dim doc As Document
  Dim fld As Field
  Dim temp As String
  Dim temp2 As String
  Dim omsg As String
  Dim matches As MatchCollection
  Dim re3 As RegExp
  Set re3 = New RegExp
  re3.Global = False
  re3.Pattern = "\s([0-9]{1,3})\W"
  Dim match As match
  Dim mval As String
 
  Dim cnt As Integer
  cnt = 0
 
  Set doc = ActiveDocument
  For Each fld In doc.Fields
    fld.Select
    If fld.Type = wdFieldIndexEntry Then
        cnt = cnt + 1
        temp = fld.Code
        If (re3.Test(temp) = True) Then
            Set matches = re3.Execute(temp)
            For Each match In matches
                mval = match.Value
            Next
 
            Dim size As Integer
            mval = Mid(mval, 2)
            mval = Left(mval, Len(mval) - 1)
            size = 4
            If (Len(mval) < (size + 1)) Then
                Do While (Len(mval) < size)
                    mval = "0" & mval
                Loop
            End If
 
            temp2 = Left(temp, Len(temp) - 1)
            temp2 = temp2 & ";" & mval & Chr$(34)
            With Selection.Find
                .Text = temp
                .Replacement.Text = temp2
                .Forward = True
                .Wrap = wdFindStop
                .Format = False
                .Execute Replace:=wdReplaceAll
            End With
        Else
            ' NOOP
        End If
    End If
  Next
  Set fld = Nothing
  Set doc = Nothing
  omsg = "Justering av indexeringsinformation klar. Indexmarkeringar totalt: "
  MsgBox (omsg & cnt)
End Sub