I have a complex stencil with many small shapes (sheet.6 to 43), grouped in a group (sheet.44). There is also sub-groups in it.
I want to hide this group using shapesheet formulas to use a user propertie.
On a simple shape I would set :
Geometry1.NoShow=sheet.44!user.isHidden
Miscellaneous.HideText=sheet.44!user.isHidden
But how to make it inherited in all sub shapes ? with vba ?
Edit with Answer :
Thank you Jon for corfirming that there is no other way than VBA.
Here is my VBA code for all of you who are having the same problem.
Call makeithidden("Sheet.164!Geometry1.NoShow", myshape)
Sub makeithidden(formula As String, ByVal myshape As Shape)
For Each subShape In myshape.Shapes
subShape.Cells("geometry1.noShow").FormulaForceU = formula
subShape.Cells("HideText").FormulaForceU = formula
Call makeithidden(formula, subShape)
Next subShape
End Sub
See you guys !
Your VBA code would have to loop through all the sub shapes and set that formula up, any time the group gets a new shape. The format of the formula would be just like your example, so it wouldn't be too hard to do:
SubShp.CellsSRC(visSectionFirstComponent,0,2).FormulaU = "Sheet." & Cstr(ParShp.ID) & "!Geometry1.NoShow"
or something like that, where that's in a loop for each SubShp in ParShp.Shapes...
Related
I want to model something similar to a (hyper-)graph in MS Visio 2016 Professional and then export the data of the shapes to csv to further work with it.
I am trying to make a VBA Script that goes through all the shapes on the sheet and writes the (manually inserted) data from the shapes to one csv file (and in the future maybe different csv files depending on the type of the shape).
To get a feeling for VBA I tried to start with a script that counts all the shapes on the sheet but I already failed on that. Please consider this is my first time working with VBA:
Sub countShapes()
Dim shp As Shape
Dim count As Integer
count = 0
Debug.Print count
For Each shp In ActiveSheet.Shapes
count = count + 1
Debug.Print count
Next
End Sub
This returns runtime error 424, object not found.
What am I missing?
As a second step, I want the script to check that shapes that have for example the same number in the data field "id" are identical in all other data fields as well and show an error if not (before exporting to the csv files). Can I realize this using vba in visio?
Thanks a lot for any help!
ActiveSheet is an Excel property. I think you're looking for ActivePage, which is a Visio equivilent. So to fix your code above you could use this:
For Each shp In ActivePage.Shapes
count = count + 1
Debug.Print count
Next
However, if you're simply after the shape count for a page then you could write this instead:
Debug.Print ActivePage.Shapes.Count
Can I recommend some links that might also help:
http://visualsignals.typepad.co.uk/vislog/2007/10/just-for-starte.html
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
vba programming for visio
As an alternative approach you might also be interested in Visio's built-in reporting tool:
Create a report of shape data (support docs)
Getting Started with Visio 16 - Build and Apply Reports from Share Data (Video)
Re the second part of your question (check data fields) I'm assuming you're talking about reading Shape Data. If that's the case you first want to check if a row named "ID" exists and, if it does, read that value. So something like this might get you going:
Public Sub TestGetCellValues()
GetShapesCellValues ActivePage, "Prop.ID"
End Sub
Public Sub GetShapesCellValues(targetPage As Visio.Page, targetCellName As String)
Dim shp As Visio.Shape
If Not targetPage Is Nothing Then
For Each shp In targetPage.Shapes
If shp.CellExistsU(targetCellName, 0) = True Then
Debug.Print shp.NameID & "!" _
& targetCellName & " = " _
& shp.CellsU(targetCellName).ResultIU
End If
Next shp
End If
End Sub
...which might output something like this (given the associated shapes):
Sheet.2!Prop.ID = 3
I have a workbook with a custom right click function that extracts cell values from another workbook depending on what the user chooses. It works very well, I just take in the cell's value from the other workbook. Some cells contain hyperlinks though, and I'd like to import the functional hyperlink, not the value of what's shown in the cell. For example, the following image contains a hyperlink in cell (Y216) of sheet BOS of the input workbook.:
This is an image of the cell I want to copy. It is indeed a hyperlink.
?application.Workbooks(2).Sheets("BOS").Range("Y216").value
returns MKB 70-203 Wicket Shear Pin Detection System, which is indeed correct.
But how do I take the hyperlink's destination? I tried several things including
?application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks.count
returns 0 even though you can see in the image that the hyperlink does have an address. In the same fashion the following sub doesn't enter the For Each because it counts 0 hyperlinks.
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks
Debug.Print HL.Address
Next
End Sub
Expected output would be the link's target J:\SOUM\3191.... as shown in image.
EDIT
If it's important the cell's formula is
=LIEN_HYPERTEXTE("J:\SOUM\3191 M - Old Hickory Dam\11_BOS_FT\02_FT_MECT\21-200 Headcover";"21-200 Headcover")
That's the =HYPERLINK function of French Excel, by the way. I guess in last resort I can take the formula and cut off the function parts to retrieve the link part?
Your command works for me, I don't know why you set the range if you want to loop through all the hyperlinks in the sheet -neither why you set as application. workbooks-, anyways, this worked fine for me:
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
You may get it as well within range methods with the following
ActiveCell.Hyperlinks(1).Address
You may get more info here
Edit:
Probably the count is wrong because of the "application.workbook", try to declare it as a variable instead of using it all over the code
Sub HLtester()
Dim HL As Hyperlink
Dim WBAnalyzed As Workbook: Set WBAnalyzed = Workbooks("MyWB.xlsm")
For Each HL In WBAnalyzed.Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
Edit 2:
This is the approach suggested when the hyperlink it's given by its formula
Sub test()
On Error Resume Next 'means no formula
x = Evaluate(Range("A1").Formula)
x1 = Sheets("Sheet1").UsedRange.Hyperlinks.Count
Debug.Print x
Debug.Print x1
End Sub
PS: I saved my variable declaration -just cause-, but, you should always have a neat control for them and use option explicit at the beginning of the module.
Apologies this seems rather basic, but i can't seem to find adequate documentation on it.
I essentially need to cycle through the rows in "Shape Data" on the shape sheet, using VBA in Visio 16. The code i'm looking for (I imagine) will look somewhat like this:
sub printLabelsAndProps()
for each x in UnknownGroupOfThings
debug.print x.prop.DataAndDocuments
debug.print x.prop.Supports
Next
end sub
Help appreciated
In case you know that all your shapes have "DataAndDocuments" and "Supports" properties, you could use something like the code below (otherwise you may need to check if the shape has those properties using .CellExists). Also if your cells contain calculated strings, then you should use .ResultStr() instead of .Formula. If those values are numbers, you can even go without .Formula
Sub printLabelsAndProps()
For Each x In ActivePage.Shapes
Debug.Print x.Cells("Prop.DataAndDocuments").Formula
Debug.Print x.Cells("Prop.Supports").Formula
Next
End Sub
If you want to cycle through all properties for a single shape, you could go with something like this:
Sub showAllProperties(x As Shape)
For i = 0 To x.Section(visSectionProp).Count - 1
Debug.Print x.CellsSRC(visSectionProp, i, visCustPropsLabel).Formula
Debug.Print x.CellsSRC(visSectionProp, i, visCustPropsValue).Formula
Next
End Sub
As far as I know, in Excel we can assign macros to several kinds of objects: shape, Form Control, ActiveX Control...
I would like to write a VBA code to do the following, given an Excel file:
Go through all the existing objects which are eligible to be assigned to a macro
For each object found, print its name and the name of its macro (or ideally the body as well) if a macro is assigned.
I would like this to be exhaustive, could anyone help?
Extending #mehow answer for shapes located in ActiveSheet the following code will result with names of shape and it's macro name if one associated.
Sub getShapeMacro()
'to secure for unexpected...
On Error Resume Next
Dim SHP As Shape
For Each SHP In ActiveSheet.Shapes
Debug.Print SHP.Name, SHP.OnAction
Next
End Sub
I want to count different types of shapes in my diagram, and I can't seem to get that done. I think I have to code something for that.
I use Visio 2007 for that.
I have a flow chart with mostly process shapes that I want to distinguish by name. E.g "Type A", "Type B". And at the end, I want to have a list that tells me how often I used Type A and Type B. Counting by hand will be to error prone.
I already checked out the report/statistic function (I'm using it in German, so I'm afraid I can't tell you the exact menu name), where you can define a report function by yourself, although that one misses features for my needs. I managed to make a report for my shapes, but only when they all are selected. But when the user has to select them by hand, then he can count them as well right from the start... And you have to make 4-5 clicks in order to get that static report result.
Another almost useful function I found was the layer method: Create a layer for the types I want to count, and then assign the shapes to that layer. But, again, this is too error prone. If the user misses a shape, the count will be wrong.
So I think I will need to code something with the VBA.
Additionally, I'd like to have a text field next to my diagram where the resulting counts for all types are always displayed. So that you see when you add a shape of Type A that the count goes up by one.
Could anyone help me on this?
try:
Option Explicit
Dim myShape As Shape
Sub ShapesDetails()
Call DeleteShapes(True)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 139.5, 81.75, 72, 72).Select
Selection.Name = "Rectangle"
ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 252.75, 71.25, 72, 72).Select
Selection.Name = "Smiley Face"
Application.CutCopyMode = False
Call ShapeDetails(True)
End Sub
Sub ShapeDetails(x As Boolean)
For Each myShape In ActiveSheet.Shapes
MsgBox "Shape name: " & myShape.Name & vbTab & " Shape type: " & myShape.Type
Next
End Sub
Sub DeleteShapes(x As Boolean)
For Each myShape In ActiveSheet.Shapes
myShape.Delete
Next
End Sub
Use Data= reports = advanced to configure a report to count objects with your custom shape Property (e.g. 'MIO') && exists. (Or another field, many to choose from). I set all the boxes i wanted to count to have property 'MIO'=TRUE, and then chose to display property Displayed Text. It takes some fiddling around in the Subtotals dialog and options in the next window to get the count looking nice. Leave COUNT unticked, and in the options dialog enable 'show all values' and tick 'exclude duplicate rows from group'.
Outputs as XML Excel Viso object. I know for the visio object, to update report, right click on it =Run report.
HTH