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

Author: iappyx

bin/InstrumentaPowerpointToolbar.ppam

@@ -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

src/InstrumentaPowerpointToolbar.pptm

@@ -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