View Single Post
  #2  
Old 02-09-2015, 04:46
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 146
Default Another variant

Code:
Sub IncOutline()
Dim s As Shape
    
    ActiveDocument.Unit = cdrPoint

    For Each s In ActiveSelectionRange
        If s.CanHaveOutline Then
            With s.Outline
                .Width = .Width + 1
            End With
        End If
    Next s
End Sub

Sub DecrOutline()
Dim s As Shape
    
    ActiveDocument.Unit = cdrPoint

    For Each s In ActiveSelectionRange
        If s.CanHaveOutline Then
            With s.Outline
                If Round(.Width, 2) < 1 Then
                    .SetNoOutline
                Else
                    .Width = .Width - 1
                End If
            End With
        End If
    Next s
End Sub
Reply With Quote