Sub DecreaseLineSpacing() : changeLineSpacingByStep -1, -0.1: End Sub
Sub IncreaseLineSpacing() : changeLineSpacingByStep 1, 0.1: End Sub
Sub DecreaseLineSpacing10() : changeLineSpacingByStep -10, -1: End Sub
Sub IncreaseLineSpacing10() : changeLineSpacingByStep 10, 1: End Sub
Sub changeLineSpacingByStep(pct, inc)
Dim sr As ShapeRange, s As Shape, p As TextRange, l
Set sr = ActiveSelectionRange: On Error GoTo clsbsDONE
ActiveDocument.BeginCommandGroup "change line spacing by " + CStr(pct) + "%" + " (" + CStr(inc) + " pt)"
Optimization = True
EventsEnabled = False
ActiveDocument.SaveSettings
ActiveDocument.PreserveSelection = False
For Each s In sr
If s.Type = cdrTextShape Then
If s.Text.IsArtisticText Then
With s.Text.Story
l = 0
Select Case .LineSpacingType
Case cdrPointLineSpacing: l = .LineSpacing + inc
Case cdrPercentOfPointSizeLineSpacing: l = .LineSpacing + pct
Case cdrPercentOfCharacterHeightLineSpacing: l = .LineSpacing + pct
Case cdrMixedLineSpacing: l = .LineSpacing
End Select
If Round(l, 3) > 0 Then .LineSpacing = l
End With
Else
For Each p In s.Text.Story.Paragraphs: l = 0
Select Case p.LineSpacingType
Case cdrPointLineSpacing: l = p.LineSpacing + inc
Case cdrPercentOfPointSizeLineSpacing: l = p.LineSpacing + pct
Case cdrPercentOfCharacterHeightLineSpacing: l = p.LineSpacing + pct
Case cdrMixedLineSpacing: l = p.LineSpacing
End Select
If Round(l, 3) > 0 Then p.LineSpacing = l
Next p
End If
End If
Next s
clsbsDONE:
ActiveDocument.PreserveSelection = True
ActiveDocument.RestoreSettings
EventsEnabled = True
Optimization = False
Application.CorelScript.RedrawScreen
ActiveDocument.EndCommandGroup
End Sub