Macro for increasing and decreasing outline widths.

[ddonnahoe]

I created 2 sub for use in X7 that I can add shortcut keys to that will increase and decrease the outline widths of selected objects.

I'm wondering if anyone could look at my code and tell if there is anything i might do differently to streamline the code...

Sub OutlinesIncrease()
    Dim s As Shape
    
    ActiveDocument.unit = cdrPoint

    For Each s In ActiveSelection.Shapes.FindShapes()
        If s.CanHaveOutline Then
            If s.Outline.Width > 0 And s.Outline.Width < 1 Then
                s.Outline.Width = 1
            End If
            If s.Outline.Width > 1 Then
                s.Outline.Width = s.Outline.Width + 1
            End If
        End If
    Next s
End Sub

Sub OutlinesDecrease()
    Dim s As Shape
    
    ActiveDocument.unit = cdrPoint

    For Each s In ActiveSelection.Shapes.FindShapes()
        If s.CanHaveOutline Then
            If s.Outline.Width > 1 Then
                s.Outline.Width = s.Outline.Width - 1
            End If
        End If
    Next s
End Sub

[shark]

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

[ddonnahoe]

Nice Shark, however this doesn't account for objects that might be grouped or selections that contain grouped items. That's why I used FindShapes().

My biggest issue now is getting Optimization to work so that it doesn't take forever to redraw if there are a lot of items selected.

[shark]

You can use

ActiveDocument.BeginCommandGroup
Optimization = True

before For-Each and

Optimization = False
ActiveDocument.EndCommandGroup

after Next s