Code / Formula to represent a Group [resizing text]

[Brandy]

@Jumpy

Have a bless extended holiday weekend....

Enjoy your vacation......

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

Brandy

[Jumpy]

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.

Code Select Expand


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.

[Brandy]

@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

[Brandy]

@Jumpy

VB does not like the "On Error Resume Next"

Complile Error:  Invalid outside procedure

Brandy

[Jumpy]

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.

[Brandy]

This is what happens when I run the new one.

Thanks

Brandy

[JuneTheSecond]

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

[Brandy]

OK, thanks

I will keep you posted

[Brandy]

@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

[Jumpy]

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

[JuneTheSecond]

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

[Brandy]

Please....  you did a wonderful job....

Thank you....

Brandy