I'm writing a code generation tool using VBA in Excel (don't ask why—long story). I need to be able to "parse" a flowchart.
The problem is that Excel allows shapes to contain text, with the exception of connectors: lines and arrows can't contain text. To label an arrow, you just put a text box on top of it—but the box isn't "attached" to the arrow in a way that VBA can easily capture.
For example, a user might draw something like this:
Within my VBA code, I can use ActiveSheet.Shapes to find that the flowchart contains seven shapes: there are five boxes (the two labels are just boxes with no border) and two arrows. Then Shape.TextFrame2 will tell me what's written inside each box, and Shape.ConnectorFormat will tell me which box goes at the start and end of each arrow.
What I need is code that can deduce:
Label A belongs to the arrow from Box 1 to Box 2
Label B belongs to the arrow from Box 1 to Box 3
I can think of three ways of doing this, none of them satisfactory.
Ask the user to group each label with its corresponding arrow.
Find out the coordinates of the endpoints of each arrow, then
calculate which arrows pass through which labels.
Find out the coordinates of the corners of each box, then calculate
which labels lie between which pairs of boxes.
Method 1 makes things easier for the programmer but harder for the user. It opens up a lot of potential for user error. I don't see this as an acceptable solution.
Method 2 would be reasonably easy to implement, except that I don't know how to find out the coordinates!
Method 3 is doable (Shape.Left etc will give the coordinates) but computationally quite messy. It also has potential for ambiguity (depending on placement, the same label may be associated with more than one arrow).
Note that methods 2 and 3 both involve trying to match every label with every arrow: the complexity is quadratic. Typical applications will have 10–50 arrows, so this approach is feasible, if somewhat inelegant.
Does anyone have a better idea? Ideally it would be something that doesn't involve coordinate geometry and complicated logic, and doesn't involve asking users to change the way they draw flowcharts.
Edited to add: example 2 in response to Tim Williams
Here's a label whose bounding box intersects the bounding box of both arrows, and whose midpoint isn't inside the bounding box of either arrow. Visually it's easy for a human to see that it belongs with the left arrow, but programmatically it's hard to deal with. If I can find out the coordinates of the arrows' endpoints, then I can calculate that one arrow passes through the label's box but the other doesn't. But if all I have is the bounding rectangles of the arrows, then it doesn't work.
Interesting problem. What if you considered the range covered by the arrow and the range covered by the textbox and matched them up based on the most overlap.
Sub ListShapes()
Dim shp As Shape
Dim shpArrow As Shape
Dim vaArrows As Variant
Dim i As Long
Dim rIntersect As Range
Dim aBestFit() As String
Dim lMax As Long
vaArrows = Split("Straight Arrow Connector 7,Straight Arrow Connector 9", ",")
ReDim aBestFit(LBound(vaArrows) To UBound(vaArrows))
For i = LBound(vaArrows) To UBound(vaArrows)
Set shpArrow = Sheet1.Shapes(vaArrows(i))
lMax = 0
For Each shp In Sheet1.Shapes
If shp.Name Like "Label*" Then
Set rIntersect = Intersect(Sheet1.Range(shp.TopLeftCell, shp.BottomRightCell), _
Sheet1.Range(shpArrow.TopLeftCell, shpArrow.BottomRightCell))
If Not rIntersect Is Nothing Then
If rIntersect.Count > lMax Then
lMax = rIntersect.Count
aBestFit(i) = shp.Name
End If
End If
End If
Next shp
Next i
For i = LBound(vaArrows) To UBound(vaArrows)
Debug.Print vaArrows(i), aBestFit(i)
Next i
End Sub
I tested this with the five box-two arrow setup and nothing more complicated. I put my two arrows in an array, but I assume you have ways to identify the arrows. I also named my untethered boxes "Label x" so I could identify them, but again I assume you have something more sophisticated.
The code loops through every arrow. Inside that loop, it loops through every shape. If it's a label, then it counts the cells in the intersection of the two ranges. Whichever has the most is stored in the best fit array.
It would be nice if you had a reasonable corpus of flow charts to test this to see where the pitfalls are. I don't think this is necessarily better than use the coordinates, just a different approach.
You can find the coordinates of the arrow's endpoints as follows.
First of all, the .Left, .Top, .Width and .Height properties describe the bounding rectangle of the arrow, as Tim Williams points out.
Next, check the .HorizontalFlip and .VerticalFlip properties. If both are false, then the arrow runs from top left to bottom right in its bounding rectangle. That is, the beginning of the arrow has coordinates (.Left,.Top) and the end has coordinates (.Left+.Width,.Top+.Height).
If either *.Flip is true, then the coordinates need to be swapped around as appropriate. E.g., if .HorizontalFlip is true but .VerticalFlip false, then the arrow runs from (.Left+.Width,.Top) to (.Left,.Top+.Height).
As far as I can tell, this is not documented anywhere on MSDN. Thanks to Andy Pope for mentioning it at excelforums.com.
Given this, method 2 seems like the best approach.
Related
Problem 1
In MS Word, the Align commands as pictured below, do not work on textboxes. I have a textbox and a shape and would like them centered together.
Solution
I'd like to write a VBA sub that'd take care of this. It is however quite complicated to determine which two objects are selected, especially if they're on a canvas or only one of them is on a canvas. It seems easier to read their names off the Selection taskpane.
Problem 2
How to determine which objects are highlighted on the Selection pane? In the example below, I'd like VBA to know that "3-Point Star 10" and "3-Point Star 9" are selected.
I'm trying to have a counter in all slides of a powerpoint presentation.
The counter needs be controlled by a button in all slides that increases it.
I can do it for one specific slide, but when I do it with a slide master it doesn't refresh the screen during Slideshow mode. I have to exit slideshow and enter again to see the changes.
Code that doesn't refresh in Slideshow mode:
ctr = ctr + 1
ActivePresentation.Designs(1).SlideMaster.Shapes("Counter").TextFrame2.TextRange.Text = ctr
Code that works (but only applies to one slide, not all slides in presentation):
ctr = ctr + 1
ActivePresentation.Slides(1).Shapes("Counter").TextFrame2.TextRange.Text = ctr
Thanks!
If your second method works, why not loop it?
Dim sld as Slide
ctr = ctr + 1
For Each sld in ActivePresentation.Slides
sld.Shapes("Counter").TextFrame2.TextRange.Text = ctr
Next
NB: This will error on any slide which doesn't contain a shape named "Counter", and you will need to add logic to handle that condition, if it exists in your Presentation.
Bookmark this link, it's the PPT Object Model Reference which, while laborious to peruse, will explain just about anything you need.
https://msdn.microsoft.com/en-us/library/office/ff743835(v=office.14).aspx
The hardest part (as a beginner) is knowing what questions to ask, and while the Object Model doesn't help you with that immediately, the more you browse it and search it, the more familiar you'll become with the different objects at your disposal, and what you can do with each of them.
If you're new to VBA entirely, also bookmark this list of VBA Statements. This has examples & definitions for all of the control flow & logic statements you might use in putting some code together.
https://msdn.microsoft.com/en-us/library/office/jj692812(v=office.15).aspx
This answer talks about how to run a macro automatically when changing slides, we'll use that approach for your problem. You'll use the OnSlideShowPageChange event because that's an auto macro and doesn't require the more complicated Application Class event handler.
How to run a macro "OnEnterSlide" or "OnLeaveSlide" in Powerpoint VBA?
Implementing this is actually a moderately complicated problem and moreso for someone who is not familiar with VBA or PowerPoint's object model.
Now, you've mentioned a number of things which either are simply not true, or at the very least it is not intuitive or obvious why these must be true, when presented with alternatives:
For that to work I would have to use a macro to add the shape to each slide individually. But then if I wanted to change the size of the shape I have to use code for that too. Not very elegant...would rather force the refresh somehow and use a master slide for the shape
(Note that the scope of your initial problem keeps increasing and becoming more complex).
The reason is to make it easier to change the shape without using code and creating the shape in all the slides.
Sometimes this is the easiest or best way to do things, sometimes it's not. I am in no position to evaluate this with regards to your specific requirements, because you've given only 2 lines of code to examine, but from my vantage point, it seems you are hesitant to write more code because you simply don't know how.
I'm sorry but your deadline is not my problem, and I've spent a generous amount of time on this answer which I hope will at least point you in the right direction.
This is a different approach, you may consider.
Add a button named Sh1, Sh2 in slide 2, Sh3 in slide 3 etc.
and attach all this shapes to the below code
For ctr = 1 To 3
If ActivePresentation.Slides(ctr).Shapes("sh" & ctr).TextFrame2.TextRange.Text = ctr Then
ActivePresentation.SlideShowWindow.View.Next
End If
Exit Sub
Next
End Sub
This would check the current slide with the counter, if matches, moves next else exits.
I’m trying to find a solution for the 2-dimensional packing problem using Excel (Formulas, Solver, VBA).
But apart from finding said solution, I would like to bring back this topic as base for discussion, because I realized during my extended web-searches that this problem (or variations of it) creates headaches for many people – novice and professional users.
The explanation for my problem:
I am trying to fit rectangular packages in rectangular containers. Usually there is one larger box and 2-5 smaller boxes to ship.
On average, there is still capacity of 30-50% left in the containers, so I want to calculate how many additional standardized boxes would fit in this free space to fill up the container.
There are no constraints, as long as the boxes fit into the container.
Height and weight are irrelevant.
The Boxes can be rotated by 90°.
One 40’ container is 1203cm long and 233cm wide.
The standardized boxes are 85cm x 70cm
The other boxes have different sizes.
I checked bin-packing algorithms but as of now I was not able to implement any solution in excel. I’d prefer a way to calculate this using Excel Solver or VBA, but my VBA-programming knowledge is limited.
The knapsack problem does not apply here in my opinion, although it is mentioned many times in this context.
In my case, I would be happy with a solution giving me something like: “You can fit at least x additional Boxes in the container”. Some inaccuracy does not matter – meaning up to 25% less boxes than possible. Too much boxes, on the other hand, are a no-go.
Now, do you guys have any idea how to get started here or even accomplish this? Maybe there is even a super-simple approximation I don’t know of?
Thanks!
UPDATE
After quite some time, I finally found some hours to get into this problem again.
I read Erwin Kalvelagen ‘s Blogposts and some papers on bin packing algorithms.
Also, the solver option is off the table.
I decided to go for a Bottom-Left-Algorithm (BLT) with some restraints (not just greedy).
Quick explanation of the BLT-Algorithm: Each box is placed in the bottom-most and left-most possible position in a given area (container). When a box is placed, it creates two new “corners” where the remaining boxes can be placed. Initially, the boxes are sorted by length (to start with the longest box) and place them in a 2-dimensional array. Then the starting point will be set in an Array (x, y coordinates) – the first coordinates are obviously 0, 0 as we start in an empty container. Then the algorithm would try to place the first box in the bottom-left corner with coordinates 0, 0 – which of course works perfectly. Then the starting cords would be replaced by the coords of one of the new corners and the coords of the other corner will be added to C. this would loop until all non-standard boxes are loaded. Then the algorithm would add standardized boxes if possible (and count them). The loop would end, if adding more boxes is not possible anymore due to constraints.
The dimension of the non-standard boxes will be entered in a worksheet - one box per row. The dimensions of the container and the standardized boxes will be written there as well.
Constraints would be, that no box can overlap another and all boxes would have to inside the container. Although rotation is practically possible, it is not necessary to implement it in the code as I am trying to orient the packages along the container.
Here is some pseudo code of the BLT-Algorithm I found:
**Procedure BLF(width, height,maxWidth)**
begin
initialize the arrays x and y
initialize the list and add the null point
for all rectangles
initialize choosePoint as impossible
while choosePoint is impossible and j < length of list
if the rectangle could be placed in a specific point
choose the point
endif
endwhile
if choosePoint is possible
update the arrays x and y
remove the point from the position choosePoint
from list
add the points (xi+width,yi),(xi,yi+height) to the points list
else
if (width > maxWidth) the problem has no solution
else xi = 0 and yi = max(heightk + yk)
where k 2 {1, . . . , i − 1}
endif
endif
endfor
solutions: the arrays x and y with (xi, yi)
the coordinates of rectangle i
end
Now, although I know a lot (like really A LOT) more about packing algorithms I am still not very experienced with VBA. Especially not with implementing algorithms.
So again I would be happy for any help you can give me to get started with the implementation.
So I started off with this (I know it’s really nothing, but I find it quite difficult):
Sub BLT1()
Dim Boxes As Variant, i As Integer, j As Integer ‘’Boxes dimensions
Dim Cntnr As Variant, a As Integer, b As Integer ‘’Container dimensions
Dim BLPoints As Variant ‘’Array with coordinates of bottom-left corners
Boxes = Range("B11:C15")
Cntnr = Range("D2:E2")
‘’Now I would like to add the first coordinates (0, 0) to the BLPoints
‘’Then I want to pick the first box and fit it in the container at the (0, 0) coordinates
‘’Then I want to update the BLPoints array with the new coordinates
…
End Sub
I’m looking forward to any constructive feedback and advice!
This is not a very easy problem. Some possible approaches are:
A MIP (Mixed Integer Programming) Model. The most complex part are the no-overlap constraint. For each box in the container we need to make sure it does not occupy space used by another box. The MIP approach has the advantage that we can find optimal solutions, or very good solutions with an indication how much we are away from a possible best solution (i.e. an indication of the quality of the solution).
A constraint programming model. Similar to the MIP model, but some constructs are easier to handle (i.e. the OR construct needed to formulate the no-overlap constraints).
A heuristic or meta-heuristic approach.
I implemented quickly a MIP model and it turns out you can get optimal or near-optimal solutions quite quickly. The solution below was found in less than a minute using a commercial MIP solver:
The yellow boxes are the required non-standard boxes and the blue ones are the optional standard boxes.
See here for more information about these no-overlap constraints. Here are the no-overlap constraints for this problem.
Is there a way to use the xlfreefloating function but only to position a graph in one direction but not the other? I have a macro that positions my graph between a certain range of cells. I want it to stay freefloating for the y direction but not the x-direction. So if the graph is to the right of some data cells, and I adjust the cells and make them longer in the x direction, I want the graph to follow. But if I adjust them in the y direction, I want them to stay the same. Thanks!
I found out how to do this myself:
One way to do this is to manually activate the chart AFTER the cells are manipulate, and then position it in terms of left or right wherever you want it. The following code was used after my charts were created, positioned, and cells were manipulated:
Sub MoveCharts()
ActiveSheet.ChartObjects("Chart 7").Activate
With ActiveChart.Parent
.Left = Range("N2").Left
End With
End Sub
I have a report that is generated in PowerPoint, and underneath many of the graphs, there is text that tells the reader to refer to pages in the appendix. I would like to be able to dynamically reference these slides.
For example, under a graph I might have the text "Please see appendix page 54", but I need the 54 to be linked to a slide so that if I insert another slide it will say 55.
Is this possible to do in VBA? I do not expect somebody to write my code for me, I would just like to know if this is a reasonable thing to do before I spend hours attempting to do it.
Side note: I feel horrible asking a question about MS Office on here, but since I believe it would need to be implemented in VBA (I don't think this functionality is built in by default) I think that it is a relevant question.
No need to feel horrible asking this here.
How one might do this:
In PPT, shapes, slides and even the presentation itself can have an associated tag collection; named string values. For example, assuming a reference to the shape in oSh, you can do:
oSh.Tags.Add "AssociatedSlideId", "293"
In this case, you'd apply this tag to your graph; the 293 would be the SlideID of the slide you want to reference. Each slide has a unique SlideID assigned when it's created; the SlideID won't change when you move the slide around/add/delete slides.
To read the tag from the shape:
Debug.Print oSh.Tags("AssociatedSlideId")
In this case, that'd return "293". Feed that to FindBySlideID to get the SlideIndex of the slide (ie, the ordinal position of the slide in the presentation). Or ask it for SlideNumber if you want the number of the slide that'll appear in number placeholders (usually, but not always the same as slide index).
Debug.Print ActivePresentation.Slides.FindBySlideID(clng("293")).SlideIndex
You might also tag the textbox or other shape that you want to use to hold the reference, then write a function along the lines of:
Function ShapeTaggedWith(oSl as Slide, sTagName as String, sTagValue as String) as Shape
This would iterate through the shapes on slide oSl looking for one with a tag named sTagName, value = sTagValue and return it to the caller if found.
Now you can find the shape that's nominated as your caption for the graph, let's call it, and change its text to match the SlideIndex (or SlideNumber) of the slide the chart's supposed to reference.
Hope that's all moderately clear; if not, that's why the StackOverflow gods gave us comments.