-
Unfortunately, I'm only allowed to work on this at work (since they won't give me access to my files from home) so you're stuck with my examples here. I think it's pretty clear from the picture what's going on, but that might just be cuz I've stared at this code for a few days already testing things :)
The problem is, for the corner routines, I have to sort based on 2 criteria. For example, in the pic above (topright prodecure), I have to get the topmost shape's value AND the rightmost shape's value -- EVEN if they are not the same shape. I think that's the key. Unfortunately, I haven't figured out a way to determine which method I should do first based on the shape layout. If they are more vertical in nature, then I should magnetize right / align tops. If they are more horizontal in nature, then I should magnetize top / align rights.
I would love to test out some things at home, but everything is locked up at work, so I'll have to wait until Monday.
:coffee:
Incidently, I think I'm eventually going to want to turn this into an add-in. The file this macro is in has various other macros that I've written to make my life easier. I setup a coworker's PowerPoint with the same macro and she couldn't run it while I was in the file making edits. If I make this an add-in, will it bypass that problem?
-
um, nevermind ;)
On second thought, it's doing what I originally wanted. I'm making this more complex than it needs to be. I think the user will inherently choose the right option when the shapes are more vertical or horizontal, then they can just choose to align them by top or right themselves.
I will try to post my working code Monday, if I can find the time. All I have to do is zip up the file and include it in a post, right? (we are not allowed ftp access at work)
-
Ok, Here's my code
Warning: Long post
Here's the code that I finally came up with. It probably will look like a joke to you masters out there, but I'm pretty much happy with the end result. The corners act a bit strange sometimes (the top, left, right and bottom are much more reliable).
Form code:
[vba]
Option Explicit
Public myChoice As String
Private Sub btn_Cancel_Click()
Call btn_Reset_Click
Unload Me
End Sub
Private Sub btn_OK_Click()
Dim myTop As Single
Dim myLeft As Single
'Dim myAlign As String
If Not myChoice = "" Then
If Not tb_gapChoice.Value = "" Then
'MsgBox ("myChoice: " & myChoice & vbLf & "myTop: " & myTop & vbLf & "myLeft: " & myLeft)
myMagnetize.magnetChoice = myChoice
myMagnetize.magGapChoice = CSng(tb_gapChoice.Value)
End If
End If
Unload Me
End Sub
Private Sub btn_Reset_Click()
tb_gapChoice.Value = 0
myChoice = ""
End Sub
Private Sub lbl_bottom_Click()
ob_bottom.Value = True
End Sub
Private Sub lbl_top_Click()
ob_top.Value = True
End Sub
Private Sub ob_bottom_Click()
myChoice = "bottom"
End Sub
Private Sub ob_bottomleft_Click()
myChoice = "bottomleft"
End Sub
Private Sub ob_bottomright_Click()
myChoice = "bottomright"
End Sub
Private Sub ob_left_Click()
myChoice = "left"
End Sub
Private Sub ob_right_Click()
myChoice = "right"
End Sub
Private Sub ob_top_Click()
myChoice = "top"
End Sub
Private Sub ob_topleft_Click()
myChoice = "topleft"
End Sub
Private Sub ob_topright_Click()
myChoice = "topright"
End Sub
Private Sub UserForm_Initialize()
Me.Top = 100
Me.Left = 100
End Sub
[/vba]
And here is the main code. I called the module "myMagnetize":
[vba]
Option Explicit
Public magnetChoice As String
Public magGapChoice As Single
Sub Magnetize()
Dim mySlide As Long
Dim shp As Shape
Dim newLeft As Single
Dim newTop As Single
Dim newWidth As Single
Dim newHeight As Single
Dim newShp As ShapeRange
Dim num As Long
Dim i As Long
'Many thanks to M.O.S. Master (Joost Verdaasdonk) and Killian from
'the VBA Express forum (http://vbaexpress.com/forum/) for
'helping me with this project.
mySlide = ActiveWindow.View.Slide.SlideIndex
frm_Magnet.Show
'MsgBox ("magnetChoice: " & magnetChoice)
Select Case magnetChoice
'MsoAlignCmd: msoAlignBottoms, msoAlignCenters, msoAlignLefts, msoAlignMiddles, msoAlignRights, msoAlignTops
'ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, False
'use TRUE if you want to align relative to slide
Case "left"
Call MoveShapesLeft
Case "topleft"
Call MoveShapesTopLeft
Case "top"
Call MoveShapesTop
Case "topright"
Call MoveShapesTopRight
Case "right"
Call MoveShapesRight
Case "bottomright"
Call MoveShapesBottomRight
Case "bottom"
Call MoveShapesBottom
Case "bottomleft"
Call MoveShapesBottomLeft
End Select
End Sub
Sub MoveShapesLeft()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColLeft colTemp
End If
End With
'reposition shapes in new order
For i = 1 To colTemp.Count
If i = 1 Then
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Left = (myMagnetize.magGapChoice * 72) + colTemp(i - 1).Left + colTemp(i - 1).Width
End If
Next
End Sub
Sub MoveShapesRight()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColRight colTemp
End If
End With
'reposition shapes in new order
For i = colTemp.Count To 1 Step -1
If i = colTemp.Count Then
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Left = colTemp(i + 1).Left - (myMagnetize.magGapChoice * 72) - colTemp(i).Width
End If
Next
End Sub
Sub MoveShapesTop()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColTop colTemp
End If
End With
'reposition shapes in new order
For i = 1 To colTemp.Count
If i = 1 Then
colTemp(i).Top = colTemp(i).Top
Else
colTemp(i).Top = colTemp(i - 1).Top + colTemp(i - 1).Height + (myMagnetize.magGapChoice * 72)
End If
Next
End Sub
Sub MoveShapesBottom()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColBottom colTemp
End If
End With
'reposition shapes in new order
For i = colTemp.Count To 1 Step -1
If i = colTemp.Count Then
colTemp(i).Top = colTemp(i).Top
Else
colTemp(i).Top = colTemp(i + 1).Top - (myMagnetize.magGapChoice * 72) - colTemp(i).Height
End If
Next
End Sub
Sub MoveShapesTopLeft()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColTopLeft colTemp
End If
End With
'reposition shapes in new order
For i = 1 To colTemp.Count
If i = 1 Then
colTemp(i).Top = colTemp(i).Top
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Top = colTemp(i - 1).Top + (myMagnetize.magGapChoice * 72) + colTemp(i - 1).Height
colTemp(i).Left = colTemp(i - 1).Left + (myMagnetize.magGapChoice * 72) + colTemp(i - 1).Width
End If
Next
End Sub
Sub MoveShapesBottomLeft()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColBottomLeft colTemp
End If
End With
'reposition shapes in new order
For i = 1 To colTemp.Count
If i = 1 Then
colTemp(i).Top = colTemp(i).Top
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Top = colTemp(i - 1).Top - (myMagnetize.magGapChoice * 72) - colTemp(i - 1).Height
colTemp(i).Left = colTemp(i - 1).Left + (myMagnetize.magGapChoice * 72) + colTemp(i - 1).Width
End If
Next
End Sub
Sub MoveShapesTopRight()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColTopRight colTemp
End If
End With
'reposition shapes in new order
For i = colTemp.Count To 1 Step -1
If i = colTemp.Count Then
colTemp(i).Top = colTemp(i).Top
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Top = colTemp(i + 1).Top + (myMagnetize.magGapChoice * 72) + colTemp(i).Height
colTemp(i).Left = colTemp(i + 1).Left - (myMagnetize.magGapChoice * 72) - colTemp(i).Width
End If
Next
End Sub
Sub MoveShapesBottomRight()
Dim colTemp As New Collection
Dim shp As Shape
Dim i As Long
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
'add all selected shapes to new collection
For Each shp In .ShapeRange
colTemp.Add shp
Next shp
'sort the collection
SortColBottomRight colTemp
End If
End With
'reposition shapes in new order
For i = colTemp.Count To 1 Step -1
If i = colTemp.Count Then
colTemp(i).Top = colTemp(i).Top
colTemp(i).Left = colTemp(i).Left
Else
colTemp(i).Top = colTemp(i + 1).Top - (myMagnetize.magGapChoice * 72) - colTemp(i).Height
colTemp(i).Left = colTemp(i + 1).Left - (myMagnetize.magGapChoice * 72) - colTemp(i).Width
End If
Next
End Sub
Sub SortColLeft(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Left > col(j).Left Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
Next j
Next i
End Sub
Sub SortColRight(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Left + col(i).Width > col(j).Left + col(j).Width Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
Next j
Next i
End Sub
Sub SortColTop(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Top > col(j).Top Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
Next j
Next i
End Sub
Sub SortColBottom(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Top + col(i).Height > col(j).Top + col(j).Height Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
Next j
Next i
End Sub
Sub SortColBottomRight(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Left + col(i).Width > col(j).Left + col(j).Width Then
If col(i).Top + col(i).Height > col(j).Top + col(j).Height Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
End If
Next j
Next i
End Sub
Sub SortColTopRight(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 1 To col.Count - 1
For j = i + 1 To col.Count
If col(i).Left + col(i).Width > col(j).Left + col(j).Width Then
If col(i).Top + col(i).Height < col(j).Top + col(j).Height Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
End If
Next j
Next i
End Sub
Sub SortColBottomLeft(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 2 To col.Count
For j = i + 1 To col.Count
If col(i).Left + col(i).Height > col(j).Left + col(j).Height Then
If col(i).Top < col(j).Top Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
End If
Next j
Next i
End Sub
Sub SortColTopLeft(col As Collection)
' bubble sort collection
' derived from http://www.dicks-blog.com/archives/2...-a-collection/
' by Dick Kusleika
Dim vItm As Shape
Dim i As Long, j As Long
Dim vTemp As Shape
For i = 2 To col.Count
For j = i + 1 To col.Count
If col(i).Left < col(j).Left Then
If col(i).Top < col(j).Top Then
Set vTemp = col(j)
col.Remove j
col.Add vTemp, , i
End If
End If
Next j
Next i
End Sub
[/vba]
-
And my final form looks like the attached picture. However, I think I want to change this to a modeless form and have it act more like a Photoshop toolbar where I just have it on screen at all times, enter a gap width and click one of the dots to have it apply without clicking OK.
-
Here's what I think I'm going to change it to.
