**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