Visio Guy

Does anyone know and/or have a code/formula that represents a group? 

I need to resize a group of shapes with different text sizes and shapes... I need a code for a group instead of individual shapes. 

A sample is attached...

(just a sample.... if you can resize this group and the text resize with the group, then you have the right code/formula)

Any, any help is greatly appreciated.

Thanks

Brandy

I think,that is what you are looking for:
http://www.visguy.com/2007/08/21/text-resizing-with-shapesheet-formulas/

Maybe I'm doing something wrong, because I can't get this to work for a group... It works wonderful for individual shapes, but not groups....

Brandy

May be you need to set formulas to all child shapes.  :) :) :) ;) ;) :D :D

That's the point.  I believe Brandy is looking for code that pushes the group response down into the sub-shapes.

Wapperdude

Then you need to access the sub-shapes
http://visguy.com/vgforum/index.php?topic=1621.0

and update their text format related cells - best you record the operation once, then adjust the recorded code to your needs.

I guess it's just me, but I didn't get the last link.... It does not apply to what I'm trying to do.  

I only need a code to represent a group...

Do you know the code for "Any Digit" "Any Font", or "Any Number"... instead of just 12 pt, because the group has a series of fonts.  

If I enter "Height/3 cm*12pt", it will only maintain the 12 pt, not the 6, 8, 10, 4, etc.

Any, any, any help is greatly appreciated.  I'm running out of time...

Thanks everyone for all your help.

Brandy

Brandy,
the sub-shapes need to know what to do - not the group!
You need to tell them how to behave.

I personally purchased a tool called Visiclone. With it, I write the formulas I need in a shape and can then copy it to other shapes. eg the sub-shapes of your group.

Paul Herber (http://visguy.com/vgforum/index.php?action=profile;u=105) has also a nice set of tools (http://www.sandrila.co.uk/visio-utilities/), which I believe are even more performant. But I did not really test them yet. Paul, that's your part here...

HeHoHeHo,
this post and the previous one are hard to follow, because it seems, that everyone means different things. So I will now happily add my misunderstanding of this topic to the knowledge pool. I wrote some code that replaces every Char.Size with the Formula:
=Height/X mm * Y pt.

where X is the Height and Y the Char.Size of the shape at the time, the code is activated.
I attached the example file, where the code was used successfully, as you can see when resizing.
Hopefully this helps,
Jumpy


Sub Change_Formula(ByVal shp As Visio.Shape)
Dim douHeight As Double
Dim douCharSize As Double
Dim strFormula As String
Dim SubShape As Visio.Shape

'Change the selected shape
douHeight = shp.Cells("Height").Result("MM")
douCharSize = shp.Cells("Char.Size").Result("pt.")
strFormula = "Height/" & douHeight & " mm *" & douCharSize & " pt."

shp.Cells("Char.Size").Formula = strFormula

'Change Sub Shapes by calling this function again
For Each SubShape In shp.Shapes
Change_Formula SubShape
Next

End Sub

'--------------------------------------------------

Sub Start()
'As the name suggests, this Makro has to be started
Dim shp As Visio.Shape

For Each shp In ActivePage.Shapes
Change_Formula shp
Next

End Sub


Can I use this in my "ShapeSheet" or I need to copy your script/code into VB?

=Height/X mm * Y pt

Well, I answer my own question, it didn't work...

Thanks

Brandy

Hi Brandy --

I just tried the code, and it worked fine.  The code is a VBA macro.  If you press Alt + F11. you'll open the VBA editor window, and the code resides under Modules.

You can copy this, open your Visio file, open the VBA editor. and paste it in.  (I'm sure there's a more direct way to do this, but this ought to work.)

Wapperdude

I did the same...  I copied it VB...  I open my diagram, went to VB, and paste the code/script. 

One question, did you do it with the diagram I attached in the previous message? 

That attachment only represents one stencil within my diagram...  I have like 25-50 of those stencils within one diagram...  Take that same diagram and add about 100 more...

I highlighted the group/diagram and paste it into the VB for that particular diagram, then I resized it to test the code and the results indicated that it does not work. 

You have been so wonderful in this dilemma...

here's a sample of one of my diagrams

This is after entering all the formulas and codes that was given to me... including the script for VB.

Nothing is working for "Groups" shapes/stencils.

Brandy

Hmmmm.  I just took the file that Jumpy provided.  Set all the character sizes to their default, fixed values.  Duplicated the group.  Ran the code, and everything went fine.

Do you get any error messages, or it simply doesn't work?  You may have some shapes that cause the code to not function.  Haven't looked at the code in detail.

Wapperdude

I still think, there is some kind of misunderstanding here.
What do you mean with stencils Brandy? Pages?
What do you mean with Group? Some shapes that are grouped together or a Selection of some shapes?

A little change in the start makro to change all shapes on all pages:


Sub Change_Formula(ByVal shp As Visio.Shape)
Dim douHeight As Double
Dim douCharSize As Double
Dim strFormula As String
Dim SubShape As Visio.Shape

'Change the selected shape
douHeight = shp.Cells("Height").Result("MM")
douCharSize = shp.Cells("Char.Size").Result("pt.")
strFormula = "Height/" & douHeight & " mm *" & douCharSize & " pt."

shp.Cells("Char.Size").Formula = strFormula

'Change Sub Shapes by calling this function again
For Each SubShape In shp.Shapes
Change_Formula SubShape
Next

End Sub

'--------------------------------------------------

Sub Start()
'As the name suggests, this Makro has to be started
Dim shp As Visio.Shape
Dim pg As Visio.Page

For Each pg In Application.ActiveDocument.Pages
For Each shp In pg.Shapes
  Change_Formula shp
Next
Next

End Sub


Stencils = Shapes

My stencils represent a type of server, such as App Server, DB Server, and Web Server.  They have more than one shape within that group. 

I uploaded a sample on my first post.   See the attachment... it's just a sample..

if you can apply the code/formula to this drawing then you have accomplished what I'm looking for in Resizing Text. 

PS:  Do not "Ungroup" the drawing... Do not set individual codes/formulas for each shape within a group.  The formula must be applied to the Group.

Good Luck....

Again, thank you, thank you so much for taking time from your(you all) busy schedules to help me with my dilemma. 

Brandy

@wapperdude, what did you do so I can repreat it on another drawing... I've been working ont he same drawing... I also tried it with one stencil/shape (Grouping) and it didn't work.

Brandy

Hi again,
if you copy my code in a new modul in the VBA Editor (not the ThisDocument Modul!!!) and then enable makros, you should be able to run the code.
Then in Extras-Makros you should find the Makro named Start and when you activate it, it should do as advertised:

It goes through all pages of your drawing.
Goes through all shapes (regardless if group or normal shape) and applies the formula.
If the shape is a group it further goes through all Subshapes of that group and applies the formula.
If the Subshape is a group, too, it furter... and so on.

I used it on your example file and it worked. look at the file I posted above. Hit Alt-F11 and you see in the VBA-Editor where I placed the Makro.

Jumpy

Hi Brandy --

What I did was take Jumpy's version of your original file.  I selected one of the subshapes in the group, opened the shapesheet and inspected the char.size cell.  It had the updated formula.  So, I reset it to default size of 18 pt, no formula.  Went thru all of the rest of the subshapes and did the same.  Then, I shrank the the group and verified that the text did not scale.  I saved this version.  Next, I ran Jumpy's code.  Again, selected the group, and shrank it.  Now the text scales with the group height.

Back to saved version.  Now I did copy paste of the group about a dozen times.  Had to increase the page size.  Added a couple of miscellaneous shapes.  Added some dynamic connectors.  Ran the macro.  All shapes had the char.size cell updated with the forumla, and all shapes exhibited text scaling.  I could not break the macro -- well, didn't try too hard.

Some definitions that need clarification:
 >>  shape = any figure --> square, triangle, line, etc.  Each has it's own shapesheet.  They can be either 1D or 2D.
 >>  Group = a collection of shapes on a drawing page.  It also has it's shapesheet.
 >>  Stencil = a special Visio page that has a collection of shapes, generally related to each thru some common theme, but not necessarily so.  These shapes are typically referred to as "Masters".

Hope this helps.

Wapperdude

Maybe it's me, it's not working....

See attachment... this is with the code that I ran.

Well, that's certainly a disappointing result.  Was this just a snapshot of the larger file?

Would it be possible to get a copy of what you've done so that we might be able to spot the problem?  Possibly, make a duplicate of the file, delete 90% of it, and then post the result.  I suspect there's some simple step that's missing, and the posts aren't catching it.

Wapperdude

Here you go... I know I'm doing something wrong.

It works for individual shapes, but not for groups.

Again, thank you so much

Brandy

Any chance of getting a Visio file?  Just a portion of the main file, but includes your efforts with macro.  In fact, a file that has the failed attempt would be good.

Wapperdude

Here's when I delete part of the code.

You will not believe this...  :D :D :D it worked on the Group-Resizing diagram I posted...

I need to delete everything I entered in the User-defined section of my original diagram and repeat the process....

I'm going to try it...


WOW!.... You(all) were so wonderful and patient with me and thank you from the bottom of my heart....

Brandy

I created another diagram and use the VB Code and it didn't work for that one.

I dropped new shapes, grouped them and ran the code.

It didn't work for the new grouping....

Brandy

Would ".forceformula" or ".forceformulau" instead of ".formula" help?

OK, I created another diagram. ???

Can someone try it on this one... I did and it doesn't work...

Any, any help is greatly appreciated.

Thanks

Brandy

@Yacine

No, it didn't work with forceformulau

Thanks anyway

Brandy

OK. Problem identified:

The Code was designed to work with shape text, that has only one general CharSize.
I did this because it's easy and it was what I thought was needed for the first resize example.

But it is possible in Visio to give a text different CharSizes for different characters.
Then the Characters Section of the ShapeSheet gets multiple rows, as you can see in the picture I made from one of the shapes in the resize3 example.

As you can see, the code only works for the first row.

How to change that is beneath me at this late hour and maybe tomorrow I have the time to look it up in Graham Wideman's book. Or someone else knows how to do it. I think a character object is needed and has to be manipulated somehow...

Chapeau, Jumpy!

You are so right....  :D ;D

It only change the first row... It was driving me crazy..... :'(

I thought it was just me....

Thank you, thank you, thank you....

I know it's late... and thank you for working this out for me...

I need to find a way to apply it to all the rows instead of just the first one....

Again, thank you so much

Brandy

Bah, schon wieder eine Tapete ruiniert! ;)
But be careful, Brandy gives you some "you are beautiful" and removes them afterwards, when it doesn't work  ;D.

OK, didn't need the charakter object, this shall do the trick:

Sub Change_Formula(ByVal shp As Visio.Shape)
Dim douHeight As Double
Dim douCharSize As Double
Dim strFormula As String
Dim SubShape As Visio.Shape
Dim i As Integer

'Change the selected shape
douHeight = shp.Cells("Height").Result("MM")

For i = 0 To shp.Section(3).Count - 1
douCharSize = shp.Section(3).Row(i).Cell(7).Result("pt.")
strFormula = "Height/" & douHeight & " mm *" & douCharSize & " pt."
shp.Section(3).Row(i).Cell(7).Formula = strFormula
Next i


'Change Sub Shapes by calling this function again
For Each SubShape In shp.Shapes
Change_Formula SubShape
Next

End Sub

Sub Start()
'As the name suggests, this Makro has to be started
Dim shp As Visio.Shape
Dim pg As Visio.Page

For Each pg In Application.ActiveDocument.Pages
For Each shp In pg.Shapes
  Change_Formula shp
Next
Next

End Sub


Thank you, thank you, thank you

I tried every code in VB to make it loop and nothing worked.  You are wonderful... just wonderful...

I tried the new code / script and it worked on/for some but not all. 

See attachement.

Again, thank you so, so much

Brandy

@Yacine,..... that's not true....  :D (Smile).....You are beautiful, just beautiful....  :)

I would like to thank you all from the bottom of my heart for taking the time to help me...

Just wonderful..... just wonderful....

Brandy

Try selecting all and set the vertical alignment and the 4 margins (top,bottom,left and right) to the same value.

See... I still think you are beautiful even if it didn't work....  :) :) :) :)

If I enlarge the shape, everything aligns correctly, but if I reduce the size... everything goes crazy.... "Go figure"....  Just my luck.... :o

See attachment...

Thank you, thank you, thank you...

Brandy

Maybe you could upload the example where it still doesn't function as .vsd again?
The formula resizes the text, accordingly to the height of the subshape, which normaly resizes accordingly to the height of the group.
But there may be formulas in the shape to alter this behaviour and so without seeing the .vsd it would be back to fruitless guessing again.

Take a rest in the Visio Tea Room, every body.  :) :) :) :)

Should I restore the formulas in "ShapeSheet" for Text Transform or User-defined?

User.txtw = TEXTWIDTH(TheText) - LeftMargin - RightMargin

or

TexWidth =GUARD(EVALTEXT(TheText)) ..... this didn't work

see attachment

Thanks

Brandy

The problem here seems to be the fixed values in the Tab Section, that is the Tabulators.
When resizing diagonally the shape width and height get smaller "proportional" (german word).
So when the text gets also smaller proportional you have no problem because it always fits in a line, because as the shape's width and so the linewidth gets smaller, the text gets smaller, too and still fits.

But if you have a fixed value for Tabulators the text in a line will at one point stay to big for the width of the shape (and the linewidth) and so you get a linebreak/newline. That you can see for example in that in the left words the spacing between the lines get doubled. Thats because the right words get between them because if the linebreak.

Solution: You have to develop a formula for changing the Tabulator that works the same as for the Charsize.

I can't help with that, because after these lines I close my Laptop and make a prolonged weekend-holiday with my family. Maybe if there is WLan in the holiday flat I will try to help you, but can't promise.

Good luck.

I found the problem.... "Tabs".....

I can't believe this... Tabs.... WOW!

Now I need to work on the tab issue..... >:( :o ??? ::) :P

Again, thank you so, so much....

Brandy

@Jumpy,

I'm so, so sorry, I should have read your posting before I submitted the last entry.

This is what I get for moving too fast....

Next time, I will read everyone's comments before I submit my solution/issue/problem/suggestions/any and every.... :) :)

Thanks

Brandy

@Jumpy

Have a bless extended holiday weekend....

Enjoy your vacation......

Again, thank you so, so much for all your help.

Brandy :) :)

Hello,
here is the promised version that changes the formula in the Tabs Section, too.
But it is still not perfect. The shape can now shrink more before the text gets disrupted, but at a certain point it will get disrupted, no matter what.
Maybe the formula has to be more complex, taking into account the different fonts itself, the number of characters before and after a tab and and and...
The only benefit is that the shapes now look better than before, when they get bigger. Thats because they always look the same now, thanks to the although growing Tab.


Dim strFormula As String
Dim SubShape As Visio.Shape
Dim i, j As Integer

On Error Resume Next

'Change the selected shape
douHeight = shp.Cells("Height").Result("MM")

For i = 0 To shp.Section(3).Count - 1
douCharSize = shp.Section(3).Row(i).Cell(7).Result("pt.")
strFormula = "Height/" & douHeight & " mm *" & douCharSize & " pt."
shp.Section(3).Row(i).Cell(7).Formula = strFormula
Next i

For j = 0 To shp.Section(5).Count - 1
For i = 1 To shp.Section(5).Row(j).Count Step 3
douTab = shp.Section(5).Row(j).Cell(i).Result("MM")
strFormula = "Height/" & douHeight & " mm *" & douTab & " mm"
shp.Section(5).Row(j).Cell(i).Formula = strFormula
Next i
Next j


'Change Sub Shapes by calling this function again
For Each SubShape In shp.Shapes
Change_Formula SubShape
Next

End Sub

Sub Start()
'As the name suggests, this Makro has to be started
Dim shp As Visio.Shape
Dim pg As Visio.Page

For Each pg In Application.ActiveDocument.Pages
For Each shp In pg.Shapes
  Change_Formula shp
Next
Next

End Sub


Thats the best I could come up with in my little spare time. Maybe it's enough.

@Jumpy

You did a wonderful job.... Thank you, thank you, thank you....

You are a Godsend....

I hope your extended vacation was wonderful.

Again, thank you so much for all your hard work. :-*

Brandy

@Jumpy

VB does not like the "On Error Resume Next"

Complile Error:  Invalid outside procedure

Brandy

Thats a standard VBA line to ignore all errors. If it weren't in the code you would get multiple error messages when looping through the sections, rows and cells, whenever a section, row, cell doesn't exist. Therefore it's necessary and I can't see, why it shouldn't work.

This is what happens when I run the new one.

Thanks

Brandy

Please, add a line at the begining.
Sub Change_Formula(shp As Visio.shape)

OK, thanks

I will keep you posted

@Jumpy

You are one of the best...

Thank you, thank you, thank you so, so much.... :-*

---

Now I need to finish working on the Connectors...

Again, thank you

Brandy

Oh sorry, I didn't see that. When I use copy+paste I shouldn't forget the first line.
Domo arigato, JuneTheSecond.

Don't mind. I often forget to copy not only first line but also last line.  :) :) :) :) :)

Please....  ;D you did a wonderful job....

Thank you....

Brandy