Contour inside of 1 mm - script has to edited - required

Can anyone help me by changing this script to 1 mm inside of bringing the contour.

Sub Contour()
Dim OrigSelection As ShapeRange
Dim s As Shape, sh As ShapeRange, s1 As Shape
Dim eff1 As Effect
Dim Cont As Long

If AutoClipperFrm.OptMm.Value = True Then
ActiveDocument.Unit = cdrMillimeter
End If

If AutoClipperFrm.OptPt.Value = True Then
ActiveDocument.Unit = cdrPoint
End If

If AutoClipperFrm.OptPx.Value = True Then
ActiveDocument.Unit = cdrPixel
End If

Set s = ActiveShape
Cont = 1
If AutoClipperFrm.TextBox1.Text < 0 Then Cont = 0
' End If
Set eff1 = s.CreateContour(Cont, Abs(AutoClipperFrm.TextBox1.Text), 1, _
cdrDirectFountainFillBlend, CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), _
CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, _
cdrContourCornerRound, 15#)
eff1.Separate.CreateSelection

Set sh = ActiveSelectionRange

If AutoClipperFrm.TextBox1.Text < 0 Then

Set s1 = sh(2).Intersect(sh(1), False, False)

Else

Set s1 = sh(2).Weld(sh(1), False, False): End If

s1.CreateSelection
End Sub