Further improving handling shapes within groups

Most functions now support shapes within groups (subselection within a group). E.g. Align only selected shapes in a group
iappyx · Feb 27, 2022 · 12153d8 · 12153d8
1 parent f8c2bbc
commit 12153d8
Show file tree

Hide file tree

Showing 8 changed files with 582 additions and 196 deletions.
diff --git a/bin/InstrumentaPowerpointToolbar.ppam b/bin/InstrumentaPowerpointToolbar.ppam
diff --git a/src/InstrumentaPowerpointToolbar.pptm b/src/InstrumentaPowerpointToolbar.pptm
diff --git a/src/Modules/ModuleAbout.bas b/src/Modules/ModuleAbout.bas
@@ -24,7 +24,7 @@ Attribute VB_Name = "ModuleAbout"
 Public InstrumentaVersion As String
 
 Sub ShowAboutDialog()
-    InstrumentaVersion = "1.04"
+    InstrumentaVersion = "1.1"
     AboutDialog.Label1.Caption = "Instrumenta Powerpoint Toolbar v" & InstrumentaVersion
     AboutDialog.Show
 End Sub
diff --git a/src/Modules/ModuleObjectsAlignAndDistribute.bas b/src/Modules/ModuleObjectsAlignAndDistribute.bas
diff --git a/src/Modules/ModuleObjectsRoundedCorners.bas b/src/Modules/ModuleObjectsRoundedCorners.bas
@@ -24,59 +24,115 @@ Attribute VB_Name = "ModuleObjectsRoundedCorners"
 Sub ObjectsCopyRoundedCorner()
     Dim SlideShape  As PowerPoint.Shape
     Set myDocument = Application.ActiveWindow
+    Dim ShapeRadius As Single
 
     If Not myDocument.Selection.Type = ppSelectionShapes Then
         MsgBox "No shapes selected."
+
+    ElseIf myDocument.Selection.HasChildShapeRange Then
+
+        If Application.ActiveWindow.Selection.ChildShapeRange(1).Adjustments.Count > 0 Then
+
+            ShapeRadius = myDocument.Selection.ChildShapeRange(1).Adjustments(1) / (1 / (myDocument.Selection.ChildShapeRange(1).Height + myDocument.Selection.ChildShapeRange(1).Width))
+
+            If myDocument.Selection.ChildShapeRange(1).Adjustments.Count > 1 Then
+                ShapeRadius2 = myDocument.Selection.ChildShapeRange(1).Adjustments(2) / (1 / (myDocument.Selection.ChildShapeRange(1).Height + myDocument.Selection.ChildShapeRange(1).Width))
+            End If
+
+            For Each SlideShape In ActiveWindow.Selection.ChildShapeRange
+                With SlideShape
+                    .AutoShapeType = myDocument.Selection.ChildShapeRange(1).AutoShapeType
+                    .Adjustments(1) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius
+                    If myDocument.Selection.ChildShapeRange(1).Adjustments.Count > 1 Then
+                        .Adjustments(2) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius2
+                    End If
+                End With
+            Next
+
+        End If
+
     Else
-
-    Dim ShapeRadius As Single
-    If Application.ActiveWindow.Selection.ShapeRange(1).Adjustments.Count > 0 Then
-
-    ShapeRadius = myDocument.Selection.ShapeRange(1).Adjustments(1) / (1 / (myDocument.Selection.ShapeRange(1).Height + myDocument.Selection.ShapeRange(1).Width))
-
-    If myDocument.Selection.ShapeRange(1).Adjustments.Count > 1 Then
-        ShapeRadius2 = myDocument.Selection.ShapeRange(1).Adjustments(2) / (1 / (myDocument.Selection.ShapeRange(1).Height + myDocument.Selection.ShapeRange(1).Width))
-    End If
-
-    For Each SlideShape In ActiveWindow.Selection.ShapeRange
-        With SlideShape
-            .AutoShapeType = myDocument.Selection.ShapeRange(1).AutoShapeType
-            .Adjustments(1) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius
+
+        For i = 1 To Application.ActiveWindow.Selection.ShapeRange.Count
+
+            If Application.ActiveWindow.Selection.ShapeRange(i).Type = msoGroup Then
+                MsgBox "One of the selected shapes is a group."
+                Exit Sub
+            End If
+
+        Next i
+
+
+        If Application.ActiveWindow.Selection.ShapeRange(1).Adjustments.Count > 0 Then
+
+            ShapeRadius = myDocument.Selection.ShapeRange(1).Adjustments(1) / (1 / (myDocument.Selection.ShapeRange(1).Height + myDocument.Selection.ShapeRange(1).Width))
+
             If myDocument.Selection.ShapeRange(1).Adjustments.Count > 1 Then
-                .Adjustments(2) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius2
+                ShapeRadius2 = myDocument.Selection.ShapeRange(1).Adjustments(2) / (1 / (myDocument.Selection.ShapeRange(1).Height + myDocument.Selection.ShapeRange(1).Width))
             End If
-        End With
-    Next
-
-    End If
-
+
+            For Each SlideShape In ActiveWindow.Selection.ShapeRange
+                With SlideShape
+                    .AutoShapeType = myDocument.Selection.ShapeRange(1).AutoShapeType
+                    .Adjustments(1) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius
+                    If myDocument.Selection.ShapeRange(1).Adjustments.Count > 1 Then
+                        .Adjustments(2) = (1 / (SlideShape.Height + SlideShape.Width)) * ShapeRadius2
+                    End If
+                End With
+            Next
+
+        End If
+
     End If
 
 End Sub
 
 Sub ObjectsCopyShapeTypeAndAdjustments()
     Dim SlideShape  As PowerPoint.Shape
     Set myDocument = Application.ActiveWindow
+    Dim AdjustmentsCount As Long
+    Dim ShapeCount  As Long
 
     If Not myDocument.Selection.Type = ppSelectionShapes Then
         MsgBox "No shapes selected."
+
+    ElseIf myDocument.Selection.HasChildShapeRange Then
+
+        For ShapeCount = 2 To ActiveWindow.Selection.ChildShapeRange.Count
+
+            myDocument.Selection.ChildShapeRange(ShapeCount).AutoShapeType = myDocument.Selection.ChildShapeRange(1).AutoShapeType
+
+            For AdjustmentsCount = 1 To myDocument.Selection.ChildShapeRange(1).Adjustments.Count
+
+                myDocument.Selection.ChildShapeRange(ShapeCount).Adjustments(AdjustmentsCount) = myDocument.Selection.ChildShapeRange(1).Adjustments(AdjustmentsCount)
+
+            Next AdjustmentsCount
+
+        Next ShapeCount
+
     Else
-
-    Dim AdjustmentsCount As Long
-    Dim ShapeCount  As Long
-
-    For ShapeCount = 2 To ActiveWindow.Selection.ShapeRange.Count
 
-        myDocument.Selection.ShapeRange(ShapeCount).AutoShapeType = myDocument.Selection.ShapeRange(1).AutoShapeType
+        For i = 1 To Application.ActiveWindow.Selection.ShapeRange.Count
+
+            If Application.ActiveWindow.Selection.ShapeRange(i).Type = msoGroup Then
+                MsgBox "One of the selected shapes is a group."
+                Exit Sub
+            End If
+
+        Next i
 
-        For AdjustmentsCount = 1 To myDocument.Selection.ShapeRange(1).Adjustments.Count
+        For ShapeCount = 2 To ActiveWindow.Selection.ShapeRange.Count
 
-            myDocument.Selection.ShapeRange(ShapeCount).Adjustments(AdjustmentsCount) = myDocument.Selection.ShapeRange(1).Adjustments(AdjustmentsCount)
+            myDocument.Selection.ShapeRange(ShapeCount).AutoShapeType = myDocument.Selection.ShapeRange(1).AutoShapeType
 
-        Next AdjustmentsCount
+            For AdjustmentsCount = 1 To myDocument.Selection.ShapeRange(1).Adjustments.Count
+
+                myDocument.Selection.ShapeRange(ShapeCount).Adjustments(AdjustmentsCount) = myDocument.Selection.ShapeRange(1).Adjustments(AdjustmentsCount)
+
+            Next AdjustmentsCount
+
+        Next ShapeCount
 
-    Next ShapeCount
-
     End If
 
 End Sub