diff --git a/bin/InstrumentaPowerpointToolbar.ppam b/bin/InstrumentaPowerpointToolbar.ppam index ec5cdd8..6a843eb 100644 Binary files a/bin/InstrumentaPowerpointToolbar.ppam and b/bin/InstrumentaPowerpointToolbar.ppam differ diff --git a/src/InstrumentaPowerpointToolbar.pptm b/src/InstrumentaPowerpointToolbar.pptm index 664eddb..b2e2a73 100644 Binary files a/src/InstrumentaPowerpointToolbar.pptm and b/src/InstrumentaPowerpointToolbar.pptm differ diff --git a/src/Modules/ModuleAbout.bas b/src/Modules/ModuleAbout.bas index 8a79179..0dbed0a 100644 --- 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 index b007c11..96cd11b 100644 --- a/src/Modules/ModuleObjectsAlignAndDistribute.bas +++ b/src/Modules/ModuleObjectsAlignAndDistribute.bas @@ -21,7 +21,6 @@ Attribute VB_Name = "ModuleObjectsAlignAndDistribute" 'OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 'SOFTWARE. - Sub ObjectsStretchTop() Set myDocument = Application.ActiveWindow @@ -30,18 +29,39 @@ Sub ObjectsStretchTop() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByTopPosition SlideShape + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + (SlideShape(ShapeCount).Top - SlideShape(1).Top) + SlideShape(ShapeCount).Top = SlideShape(1).Top + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + (SlideShape(ShapeCount).Top - SlideShape(1).Top) + SlideShape(ShapeCount).Top = SlideShape(1).Top + Next ShapeCount + + End If - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + (SlideShape(ShapeCount).Top - SlideShape(1).Top) - SlideShape(ShapeCount).Top = SlideShape(1).Top - Next ShapeCount End Sub Sub ObjectsStretchLeft() @@ -52,18 +72,39 @@ Sub ObjectsStretchLeft() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - - ObjectsSortByLeftPosition SlideShape + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + (SlideShape(ShapeCount).Left - SlideShape(1).Left) + SlideShape(ShapeCount).Left = SlideShape(1).Left + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + (SlideShape(ShapeCount).Left - SlideShape(1).Left) + SlideShape(ShapeCount).Left = SlideShape(1).Left + Next ShapeCount + + End If - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + (SlideShape(ShapeCount).Left - SlideShape(1).Left) - SlideShape(ShapeCount).Left = SlideShape(1).Left - Next ShapeCount End Sub Sub ObjectsStretchBottom() @@ -74,18 +115,39 @@ Sub ObjectsStretchBottom() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByBottomPosition SlideShape - - For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 - SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + ((SlideShape(UBound(SlideShape)).Top + SlideShape(UBound(SlideShape)).Height) - SlideShape(ShapeCount).Top - SlideShape(ShapeCount).Height) + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByBottomPosition SlideShape + + For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 + SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + ((SlideShape(UBound(SlideShape)).Top + SlideShape(UBound(SlideShape)).Height) - SlideShape(ShapeCount).Top - SlideShape(ShapeCount).Height) + + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - Next ShapeCount + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByBottomPosition SlideShape + + For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 + SlideShape(ShapeCount).Height = SlideShape(ShapeCount).Height + ((SlideShape(UBound(SlideShape)).Top + SlideShape(UBound(SlideShape)).Height) - SlideShape(ShapeCount).Top - SlideShape(ShapeCount).Height) + + Next ShapeCount + + End If + End Sub Sub ObjectsStretchRight() @@ -96,18 +158,38 @@ Sub ObjectsStretchRight() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByRightPosition SlideShape - - For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 - SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + ((SlideShape(UBound(SlideShape)).Left + SlideShape(UBound(SlideShape)).Width) - SlideShape(ShapeCount).Left - SlideShape(ShapeCount).Width) + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByRightPosition SlideShape + + For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 + SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + ((SlideShape(UBound(SlideShape)).Left + SlideShape(UBound(SlideShape)).Width) - SlideShape(ShapeCount).Left - SlideShape(ShapeCount).Width) + + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByRightPosition SlideShape - Next ShapeCount + For ShapeCount = UBound(SlideShape) - 1 To 1 Step -1 + SlideShape(ShapeCount).Width = SlideShape(ShapeCount).Width + ((SlideShape(UBound(SlideShape)).Left + SlideShape(UBound(SlideShape)).Width) - SlideShape(ShapeCount).Left - SlideShape(ShapeCount).Width) + + Next ShapeCount + + End If End Sub Sub ObjectsRemoveSpacingHorizontal() @@ -118,17 +200,36 @@ Sub ObjectsRemoveSpacingHorizontal() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - - ObjectsSortByLeftPosition SlideShape - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Left = SlideShape(ShapeCount - 1).Left + SlideShape(ShapeCount - 1).Width - Next ShapeCount + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount - 1).Left + SlideShape(ShapeCount - 1).Width + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount - 1).Left + SlideShape(ShapeCount - 1).Width + Next ShapeCount + + End If End Sub Sub ObjectsRemoveSpacingVertical() @@ -139,17 +240,36 @@ Sub ObjectsRemoveSpacingVertical() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByTopPosition SlideShape - - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Top = SlideShape(ShapeCount - 1).Top + SlideShape(ShapeCount - 1).Height - Next ShapeCount + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount - 1).Top + SlideShape(ShapeCount - 1).Height + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount - 1).Top + SlideShape(ShapeCount - 1).Height + Next ShapeCount + + End If End Sub Sub ObjectsIncreaseSpacingHorizontal() @@ -160,17 +280,36 @@ Sub ObjectsIncreaseSpacingHorizontal() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByLeftPosition SlideShape + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left + (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + Else + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left + (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + End If - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left + (ShapeCount - 1) * 0.01 * 28.34646 - Next ShapeCount End Sub Sub ObjectsDecreaseSpacingHorizontal() @@ -181,17 +320,36 @@ Sub ObjectsDecreaseSpacingHorizontal() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - - ObjectsSortByLeftPosition SlideShape - - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left - (ShapeCount - 1) * 0.01 * 28.34646 - Next ShapeCount + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left - (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByLeftPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Left = SlideShape(ShapeCount).Left - (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + End If End Sub Sub ObjectsIncreaseSpacingVertical() @@ -202,17 +360,37 @@ Sub ObjectsIncreaseSpacingVertical() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - ObjectsSortByTopPosition SlideShape + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top + (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top + (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + End If - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top + (ShapeCount - 1) * 0.01 * 28.34646 - Next ShapeCount End Sub Sub ObjectsDecreaseSpacingVertical() @@ -223,17 +401,37 @@ Sub ObjectsDecreaseSpacingVertical() Dim ShapeCount As Long Dim SlideShape() As Shape - ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) - For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) - Next ShapeCount - - ObjectsSortByTopPosition SlideShape + If myDocument.Selection.HasChildShapeRange Then + + ReDim SlideShape(1 To myDocument.Selection.ChildShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ChildShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ChildShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top - (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + Else + + ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count) + + For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count + Set SlideShape(ShapeCount) = myDocument.Selection.ShapeRange(ShapeCount) + Next ShapeCount + + ObjectsSortByTopPosition SlideShape + + For ShapeCount = 2 To UBound(SlideShape) + SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top - (ShapeCount - 1) * 0.01 * 28.34646 + Next ShapeCount + + End If - For ShapeCount = 2 To UBound(SlideShape) - SlideShape(ShapeCount).Top = SlideShape(ShapeCount).Top - (ShapeCount - 1) * 0.01 * 28.34646 - Next ShapeCount End Sub Sub ObjectsSortByLeftPosition(ArrayToSort As Variant) @@ -341,7 +539,11 @@ Sub ObjectsAlignLefts() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignLefts, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignLefts, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignLefts, msoFalse @@ -354,7 +556,11 @@ Sub ObjectsAlignRights() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignRights, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignRights, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignRights, msoFalse @@ -367,7 +573,11 @@ Sub ObjectsAlignBottoms() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignBottoms, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignBottoms, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignBottoms, msoFalse @@ -380,7 +590,11 @@ Sub ObjectsAlignCenters() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignCenters, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignCenters, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignCenters, msoFalse @@ -393,7 +607,11 @@ Sub ObjectsAlignMiddles() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignMiddles, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignMiddles, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignMiddles, msoFalse @@ -406,7 +624,11 @@ Sub ObjectsAlignTops() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If myDocument.Selection.ShapeRange.Count = 1 Then + If myDocument.Selection.HasChildShapeRange Then + If myDocument.Selection.ChildShapeRange.Count > 1 Then + myDocument.Selection.ChildShapeRange.Align msoAlignTops, msoFalse + End If + ElseIf myDocument.Selection.ShapeRange.Count = 1 Then myDocument.Selection.ShapeRange.Align msoAlignTops, msoTrue Else myDocument.Selection.ShapeRange.Align msoAlignTops, msoFalse @@ -420,9 +642,16 @@ Sub ObjectsDistributeHorizontally() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub If myDocument.Selection.ShapeRange.Count > 2 Then - myDocument.Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse + myDocument.Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse + + ElseIf myDocument.Selection.HasChildShapeRange Then + + If myDocument.Selection.ChildShapeRange.Count > 2 Then + myDocument.Selection.ChildShapeRange.Distribute msoDistributeHorizontally, msoFalse + End If + Else - MsgBox "Select more shapes to use this command." + MsgBox "Select more shapes to use this command." End If End Sub @@ -433,8 +662,17 @@ Sub ObjectsDistributeVertically() If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub If myDocument.Selection.ShapeRange.Count > 2 Then - myDocument.Selection.ShapeRange.Distribute msoDistributeVertically, msoFalse + myDocument.Selection.ShapeRange.Distribute msoDistributeVertically, msoFalse + + ElseIf myDocument.Selection.HasChildShapeRange Then + + If myDocument.Selection.ChildShapeRange.Count > 2 Then + + myDocument.Selection.ChildShapeRange.Distribute msoDistributeVertically, msoFalse + + End If + Else - MsgBox "Select more shapes to use this command." + MsgBox "Select more shapes to use this command." End If End Sub diff --git a/src/Modules/ModuleObjectsRoundedCorners.bas b/src/Modules/ModuleObjectsRoundedCorners.bas index b43a3eb..b8a05c5 100644 --- a/src/Modules/ModuleObjectsRoundedCorners.bas +++ b/src/Modules/ModuleObjectsRoundedCorners.bas @@ -24,32 +24,65 @@ 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 @@ -57,26 +90,49 @@ 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 diff --git a/src/Modules/ModuleObjectsSizeAndPosition.bas b/src/Modules/ModuleObjectsSizeAndPosition.bas index fc13d1f..05b6ca7 100644 --- a/src/Modules/ModuleObjectsSizeAndPosition.bas +++ b/src/Modules/ModuleObjectsSizeAndPosition.bas @@ -23,62 +23,115 @@ Attribute VB_Name = "ModuleObjectsSizeAndPosition" Sub ObjectsSizeToTallest() Set myDocument = Application.ActiveWindow - - If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - Dim Tallest As Single - Tallest = myDocument.Selection.ShapeRange(1).Height - - For Each SlideShape In ActiveWindow.Selection.ShapeRange - If SlideShape.Height > Tallest Then Tallest = SlideShape.Height - Next + If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Height = Tallest + If myDocument.Selection.HasChildShapeRange Then + + Tallest = myDocument.Selection.ChildShapeRange(1).Height + + For Each SlideShape In myDocument.Selection.ChildShapeRange + If SlideShape.Height > Tallest Then Tallest = SlideShape.Height + Next + + myDocument.Selection.ChildShapeRange.Height = Tallest + + Else + Tallest = myDocument.Selection.ShapeRange(1).Height + + For Each SlideShape In myDocument.Selection.ShapeRange + If SlideShape.Height > Tallest Then Tallest = SlideShape.Height + Next + + myDocument.Selection.ShapeRange.Height = Tallest + + End If End Sub Sub ObjectsSizeToShortest() Set myDocument = Application.ActiveWindow - - If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - Dim Shortest As Single - Shortest = myDocument.Selection.ShapeRange(1).Height - - For Each SlideShape In ActiveWindow.Selection.ShapeRange - If SlideShape.Height < Shortest Then Shortest = SlideShape.Height - Next + If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Height = Shortest + If myDocument.Selection.HasChildShapeRange Then + + Shortest = myDocument.Selection.ChildShapeRange(1).Height + + For Each SlideShape In myDocument.Selection.ChildShapeRange + If SlideShape.Height < Shortest Then Shortest = SlideShape.Height + Next + + myDocument.Selection.ChildShapeRange.Height = Shortest + + Else + + Shortest = myDocument.Selection.ShapeRange(1).Height + + For Each SlideShape In myDocument.Selection.ShapeRange + If SlideShape.Height < Shortest Then Shortest = SlideShape.Height + Next + + myDocument.Selection.ShapeRange.Height = Shortest + + End If End Sub Sub ObjectsSizeToWidest() Set myDocument = Application.ActiveWindow - - If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - Dim Widest As Single - Widest = myDocument.Selection.ShapeRange(1).Width - - For Each SlideShape In ActiveWindow.Selection.ShapeRange - If SlideShape.Width > Widest Then Widest = SlideShape.Width - Next + If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Width = Widest + If myDocument.Selection.HasChildShapeRange Then + + Widest = myDocument.Selection.ChildShapeRange(1).Width + + For Each SlideShape In myDocument.Selection.ChildShapeRange + If SlideShape.Width > Widest Then Widest = SlideShape.Width + Next + + myDocument.Selection.ChildShapeRange.Width = Widest + + Else + Widest = myDocument.Selection.ShapeRange(1).Width + + For Each SlideShape In myDocument.Selection.ShapeRange + If SlideShape.Width > Widest Then Widest = SlideShape.Width + Next + + myDocument.Selection.ShapeRange.Width = Widest + + End If End Sub Sub ObjectsSizeToNarrowest() Set myDocument = Application.ActiveWindow Dim Narrowest As Single - Narrowest = myDocument.Selection.ShapeRange(1).Width - - For Each SlideShape In ActiveWindow.Selection.ShapeRange - If SlideShape.Width < Narrowest Then Narrowest = SlideShape.Width - Next + If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Width = Narrowest + If myDocument.Selection.HasChildShapeRange Then + + Narrowest = myDocument.Selection.ChildShapeRange(1).Width + + For Each SlideShape In myDocument.Selection.ChildShapeRange + If SlideShape.Width < Narrowest Then Narrowest = SlideShape.Width + Next + + myDocument.Selection.ChildShapeRange.Width = Narrowest + + Else + + Narrowest = myDocument.Selection.ShapeRange(1).Width + + For Each SlideShape In myDocument.Selection.ShapeRange + If SlideShape.Width < Narrowest Then Narrowest = SlideShape.Width + Next + + myDocument.Selection.ShapeRange.Width = Narrowest + + End If End Sub @@ -86,7 +139,11 @@ Sub ObjectsSameHeight() Set myDocument = Application.ActiveWindow If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Height = myDocument.Selection.ShapeRange(1).Height + If myDocument.Selection.HasChildShapeRange Then + myDocument.Selection.ChildShapeRange.Height = myDocument.Selection.ChildShapeRange(1).Height + Else + myDocument.Selection.ShapeRange.Height = myDocument.Selection.ShapeRange(1).Height + End If End Sub @@ -94,7 +151,11 @@ Sub ObjectsSameWidth() Set myDocument = Application.ActiveWindow If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Width = myDocument.Selection.ShapeRange(1).Width + If myDocument.Selection.HasChildShapeRange Then + myDocument.Selection.ChildShapeRange.Width = myDocument.Selection.ChildShapeRange(1).Width + Else + myDocument.Selection.ShapeRange.Width = myDocument.Selection.ShapeRange(1).Width + End If End Sub @@ -102,8 +163,14 @@ Sub ObjectsSameHeightAndWidth() Set myDocument = Application.ActiveWindow If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - myDocument.Selection.ShapeRange.Height = myDocument.Selection.ShapeRange(1).Height - myDocument.Selection.ShapeRange.Width = myDocument.Selection.ShapeRange(1).Width + If myDocument.Selection.HasChildShapeRange Then + myDocument.Selection.ChildShapeRange.Height = myDocument.Selection.ChildShapeRange(1).Height + myDocument.Selection.ChildShapeRange.Width = myDocument.Selection.ChildShapeRange(1).Width + + Else + myDocument.Selection.ShapeRange.Height = myDocument.Selection.ShapeRange(1).Height + myDocument.Selection.ShapeRange.Width = myDocument.Selection.ShapeRange(1).Width + End If End Sub @@ -111,24 +178,44 @@ Sub ObjectsSwapPosition() Set myDocument = Application.ActiveWindow If Not myDocument.Selection.Type = ppSelectionShapes Then Exit Sub - If ActiveWindow.Selection.ShapeRange.Count = 2 Then - Dim Left1, Left2, Top1, Top2 As Single - Left1 = ActiveWindow.Selection.ShapeRange(1).Left - Left2 = ActiveWindow.Selection.ShapeRange(2).Left - Top1 = ActiveWindow.Selection.ShapeRange(1).Top - Top2 = ActiveWindow.Selection.ShapeRange(2).Top - - ActiveWindow.Selection.ShapeRange(1).Left = Left2 - ActiveWindow.Selection.ShapeRange(2).Left = Left1 - ActiveWindow.Selection.ShapeRange(1).Top = Top2 - ActiveWindow.Selection.ShapeRange(2).Top = Top1 - + If ActiveWindow.Selection.ShapeRange.Count = 2 Then + + Left1 = ActiveWindow.Selection.ShapeRange(1).Left + Left2 = ActiveWindow.Selection.ShapeRange(2).Left + Top1 = ActiveWindow.Selection.ShapeRange(1).Top + Top2 = ActiveWindow.Selection.ShapeRange(2).Top + + ActiveWindow.Selection.ShapeRange(1).Left = Left2 + ActiveWindow.Selection.ShapeRange(2).Left = Left1 + ActiveWindow.Selection.ShapeRange(1).Top = Top2 + ActiveWindow.Selection.ShapeRange(2).Top = Top1 + + ElseIf myDocument.Selection.HasChildShapeRange Then + + If myDocument.Selection.ChildShapeRange.Count = 2 Then + + Left1 = myDocument.Selection.ChildShapeRange(1).Left + Left2 = myDocument.Selection.ChildShapeRange(2).Left + Top1 = myDocument.Selection.ChildShapeRange(1).Top + Top2 = myDocument.Selection.ChildShapeRange(2).Top + + myDocument.Selection.ChildShapeRange(1).Left = Left2 + myDocument.Selection.ChildShapeRange(2).Left = Left1 + myDocument.Selection.ChildShapeRange(1).Top = Top2 + myDocument.Selection.ChildShapeRange(2).Top = Top1 + + Else + + MsgBox "Select two shapes to swap positions." + + End If + Else - - MsgBox "Select two shapes to swap positions." - + + MsgBox "Select two shapes to swap positions." + End If End Sub diff --git a/v/1.04.md b/v/1.04.md index b3c4b09..aa8509d 100644 --- a/v/1.04.md +++ b/v/1.04.md @@ -1,5 +1,5 @@ -## You are using the latest version of Instrumenta! +## There is a new version available! -If you want to re-download it: -- Direct download: https://github.com/iappyx/Instrumenta/raw/main/bin/InstrumentaPowerpointToolbar.ppam -- More info: https://github.com/iappyx/Instrumenta/ +You can download it here: https://github.com/iappyx/Instrumenta/raw/main/bin/InstrumentaPowerpointToolbar.ppam + +More info: https://github.com/iappyx/Instrumenta/ diff --git a/v/1.1.md b/v/1.1.md new file mode 100644 index 0000000..b3c4b09 --- /dev/null +++ b/v/1.1.md @@ -0,0 +1,5 @@ +## You are using the latest version of Instrumenta! + +If you want to re-download it: +- Direct download: https://github.com/iappyx/Instrumenta/raw/main/bin/InstrumentaPowerpointToolbar.ppam +- More info: https://github.com/iappyx/Instrumenta/