Printable View
Is there a way to get stats (like top, left, width, height) of the bounding box of a selection?
I am trying to make a macro that does the following:
- align objects to the topleft, topright, bottomleft or bottomright of a selection. If any shapes overlap originally, I would like them to snap to the edges of the other objects, kind of like a magnet.
Please don't just give me the macro (that would be nice but I'm trying to learn). :)
Hi, :hi:
Ok, have great problems understanding this question. (english probably not to good over here!!)
But normaly I do this to align my shapes:
- Get the drawing toolbar: view | toolbars | drawing
- Press the "select objects" (cursor shaped) tool and draw over your shapes to select them
- Then in the draw menu choose: Draw | Align or distrubite | make your choise (remember choose relative to page or not)
Is this what your after and if not... please clarify some more for the dummie over here.. :*)
Hi Mos,
Yes, I use that alignment toolbar quite frequently. However, it aligns all objects and stacks them on top of each other. I kind of want to "enhance" this by making them not stack.
Here's some clarification, I hope. I have attached the form I'm using. Based on this form, I want to simulate the alignment features on the Alignment toolbar, but instead of stacking them, make it like they snap to each shape's sides (like the picture shown below).
I hope that makes it somewhat more clear?
woops, it only let me add 1 attachment. Here's the form I'm using.
so basically, I wanted to find out the dimensions of the total selected shapes (bounding box), or... alternatively, I was going to move the shapes based on a certain corner of the screen. I figure either way it's going to use a similar procedure.
I'm just not sure how to go about doing it.
Killian helped me on a different question that I might be able to tweak his code to make this work. I think I have thought out the concepts pretty well, but I don't know enough about the PowerPoint vba model to make it happen. :(
Hi Tom, :D
Ok getting your question now. I'll go and eat now and return later to see if I can wip up some code for you to get started.
HTH.
just as a side note, I only need to figure out how to do it for top, bottom, left and right. The diagonals are the same thing, with a normal align thrown in first.
i.e. -- Upper Right = 1) Align Top, 2) magnetize Right
Hi Tom, :)
Ok let's take it one step at the time. If I give you the code for all 4 sides than you don't have anything to play with.
Ok for the picture above (colored shapes) you can try out this code: [vba]
Sub MoveShapes()
Dim i As Integer
Dim iOld As Single
Dim iNew As Single
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
For i = 2 To .ShapeRange.Count
iOld = .ShapeRange(i).Left
iNew = (.ShapeRange(i - 1).Left + .ShapeRange(i - 1).Width)
If iNew = iOld Then
.ShapeRange(i).Left = .ShapeRange(i - 1).Left
Else
.ShapeRange(i).Left = iNew
End If
Next
End If
End With
End Sub
[/vba]
It's not the neatest bit of code I've ever written but It will do just fine to start off with.
You need to remember that you need to tell the code exactly what to do and which problems it can find on its way.
For this code I've taken the following into account:
* Skip the first one its place is fine
* Attach the second one to the right side of the first one (of you need (.Left from shape 1 + .Width from shape 1) to get the right .Left property to set to shape 2
* if all shapes where placed out of allignment then this would be enough logic.
* But what if shapes 3, 4 and 5 are allready alligned beneat each other? (that's why I check for previous left to new left) if matched choose previous left.
The code is NOT entirly perfect for now because when you run it a second time the second shape moves to the left of the first shape. (because a previous condition is met) But if you run the macro again (3rd time) then All is good again.
I just posted it to give you something to play with.
HTH.:whistle:
Wow MOS, that's pretty neat.
<plug in blender>
<insert brain>
<click PUREE>
...
This is going to take me some time to sift through and understand. :)
Your example reveals to me that I might be in for some trouble when I get to the part of aligning on the top, right or bottom. So you're telling me I can't refer to a "hotspot" other then the top, left corner on a shape to align things with?
If this is the case, I guess I will have to add widths or heights depending on the user's choice. I was hoping it would be easier, but it's actually not that much more difficult; it just takes a little more planning. Maybe for the right align I could reverse the loop to go from .shaperange.count to 1 and subtract widths.
ok, after some testing, I have some questions:
1) How are shapes numbered based on a selection? Is it topmost first, then leftmost? Or is it simply which one is created first?
2) Is there any way to specifically determine the way they're numbered in a selection?
For instance, for the LEFT align, i would like the leftmost shape to be #1, then the next, and so on. It seems to be based on which shape was created first, but I'd like to renumber them if that's the case so I can work with them in the loop.
In the picture below, I would expect it to go C, A, B... but since A was created first, then B, then C that's how it ordered it (I think).
i modified your code a little to see if I could get the .left values of my shapes, but how do I get these values into a variable (or array?) instead of a textframe? I would like to work with the values to determine which is the leftmost, and then place them accordingly.
[vba]
Sub LeftValues()
Dim i As Integer
Dim iOld As Single
Dim iNew As Single
With ActiveWindow.Selection
If .Type = ppSelectionShapes Then
For i = 1 To .ShapeRange.Count
.ShapeRange(i).TextFrame.TextRange.Text = .ShapeRange(i).Left
Next
End If
End With
End Sub
[/vba]
... or maybe I'm trying to attack this in the wrong way, as usual. :)
Hi guys :hi:
Another approach would be to add your selected shapes to a new collection, sort the collection by the members' Left/top property then re-position the shapes in order.
I've given it a try just dealing with the simple "order from left" scenario.
Any use?[VBA]Sub main()
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
SortCollection colTemp
End If
End With
'reposition shapes in new order
For i = 2 To colTemp.Count
colTemp(i).Left = colTemp(i - 1).Left + colTemp(i - 1).Width
Next
End Sub
Sub SortCollection(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[/VBA]
Ok, so if I understand this right, it's basically using the same logic, but by putting it into a "collection" it enabled it to sort it? What is a collection? Is that just another object type?
I also noticed in your variable declarations, you have "... As New Collection". What is the difference between As and As New?
Wow, I added a spacer value and this doubles as a way to evenly space objects based on a specific gap width (instead of relative to the selection or page).
I'm going to mark this post solved. Hopefully I will be able to understand it enough to incorporate it into the other options on my form.
Thanks again guys. I really appreciate you taking the time to explain things.
-TT
Hey guys:
Final update on this topic. I finally managed to figure out the logic behind your examples, and I was able to get the other options working! I couldn't have done it without your help. Thanks again for all of your help.
:bow:
Glad its all coming together! :thumb
Collections are worth knowing about, although you already use them extensively:Quote:
What is a collection? Is that just another object type?
Application.Presentations returns a collection of all open presentations
Presentation(1).Slides returns a collection of all the slides in the first open pres
Slides(1).Shapes returns a collection of all the shapes on slide 1
etc, etc...
You can create your own Collection objects and use them in the same way.
[VBA]Dim myCol As Collection[/VBA]will create an object reference of type collection. You could then assign an existing collection to that object reference (myCol).Quote:
What is the difference between As and As New?
The "New" keyword will create a new object, so you could then use[VBA]Set myCol = New Collection[/VBA]I chose just to create the new instance when I declared the variable instead.
Hi Tom, :DQuote:
Originally Posted by TrippyTom
Glad to see it's working out for yah.
Could you post the final code you used in the end for the other options so we can see what you did whit it and others can learn from your hard work?
Thnx. :whistle:
Well, I ran into something that I hadn't thought of during my original planning phase. I will try to explain what's happening and how I think I'm going to fix it (see picture below).
As you can see, it's behaving exactly as my code intended, but I have to alter the code so it handles corners a bit differently. For instance, if topright is chosen, I should modify the sort routine by the topright of each shape in the collection, then modify the positioning part of the code to:
1) remember the first shapes top value
2) magnetize right and align ALL shapes based on that first top value
... at least that's how I think it will work. Sound right, or has your brain exploded like mine? :bug:
Now that I think of it, after i magnetize right, i could just use this to align top:
... this isn't a very elegant fix, because if the shapes are like in the picture below, it will still position them strangely, but I don't think there's a way to use a conditional statement for those types of situations, is there?Code:ActiveWindow.Selection.ShapeRange.Align msoAlignTops, False
Hi Tom, :)
Well my head is spinning for sure on this one. Cause I fall in to it cold every day. (that's why you should figure out the buisness logic upfront)
Perhaps we can work in another method from now cause it's getting complex and an example always speaks a thousend words.
Could you strip down your project to the userform and the code for alligning the shapes? (with how fare you've coded)
Then put a few pictures in the zip file as well with all types of aliging you have in mind so we know the total scope of the job.
From there on we can start skinning this puppy thil we get there! :p
Ps.. don't know if I have time for it today but there will always be more days..
HTH.
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?
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)
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.