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
Related
hopefully you can help me with this!
I am writing a code in VBA and I am having issues with the Selection object acting differently than I expect.
When I write a for loop as in
For Each Cell in Selection
MsgBox Cell.Value
Next Cell
It works as expected, but then I try to index it and it acts differently. Especially it is a non-contiguous cell selection.
Like this;
For i = 0 to 5
MsgBox Selection(i).Value
Next i
It gives pretty random values. any insight would be great!
Edit:
Thanks for the input everyone, it seems I need to find another way of doing the following. I have a piece of code that takes a user's selected cells and uses those values for calculations. Right now, I have been trying to make it so they can select non-contiguous cells. Basically, I need to make an array of these values, and my thoughts were to make a for loop as follows
For I = 0 To 5
Array(i) = Selection(i).Value
Next I
I'm not sure if there is another way of doing this. If anyone has some suggestions, I am interested!
As others have stated, you should not use Selection this way. But to answer your question...I did some quick testing based on your example use-case.
It appears that when you loop cell in Selection it goes left to right, then top to bottom by range area. So for example if you have two non-contiguous ranges selected then if will look something like this:
When you index it, it does not seem to make the jump between range areas. instead it will continue iterating left to right top to bottom within the column bounds of the first range area:
So if you slected 2 columns, iterating on the index would just continue down the first column, even if it is outside of the selection.
My test code:
Private Sub testing()
Dim i As Integer
For i = 1 To Selection.Cells.Count
Selection(i).Value = i
Next i
End Sub
Private Sub testing2()
Dim c As Range
For Each c In Selection.Cells
c.Value = c.Column
Next c
End Sub
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.
I cannot figure out the best way to do the following problem. Basically my macro (excel, VB) is checking several (100+) worksheets for correct values, if wrong value is found, I want it to stop, give me a warning, then I could have a look into the reason why the value is wrong, correct it manually and then I want to resume the macro, or remember the last value checked so if I return, it remembers where to continue (resume).
My current problem is that it finds the wrong value, then I can either make it stop so I check the problem, or it goes through all the sheets and then I have to remember which sheets had the wrong value.
What I thought of is make a list where the name of sheet is added every time a wrong value is found. The problem is that usually there is more than 1 wrong value in the same sheet if there is a wrong value at all and this added the same sheet name several times to the list. Another problem with that is that I cannot correct the values straight away.
I'm very inexperienced with programming and so would appreciate your idea on how to best approach this problem (I don't want to spend a long time on coding something which wouldn't be efficient for such a "simple" problem).
When the error is found (I'm assuming you've already been able to identify this), you can use the Application.InputBox function to prompt you for a new value.
For example, if rng is a Range variable that represents the cell being checked, and you have some logic to determine where the error happens, then you can just do:
rng.Value = Application.InputBox("Please update the value in " & rng.Address, "Error!", rng.Value)
The inputbox function effectively halts execution of the procedure, while waiting for input from the user.
If InputBox isn't robust enough, then you can create a custom UserForm to do the same sort of thing. But for modifying single range values, one at a time, the InputBox is probably the easiest to implement.
I believe you can handle this task by using one or two static local variables in your macro. A variable declared with "static" rather than "dim" will remember its value from the last time that procedure was run. This can hold where you left off so you can resume from there.
One thing that could be a problem with this solution would be if the macro gets recompiled. That would probably cause VBA to clear the value that the static variable was holding. Just doing a data edit in Excel should not cause a recompile, but you will want to watch for this case, just to make sure it doesn't come up. It almost certainly will if you edit any code between executions.
Create a public variable that stores the cell address of the last checked cell and use a conditional statement to see if it's "mid-macro" for want of a better phrase. here is a very crude example...
Public lastCellChecked As String
Sub Check_Someting()
Dim cell As Excel.Range
Dim WS As Excel.Worksheet
If Not lastCellChecked = vbNullString Then Set cell = Evaluate(lastCellChecked)
'// Rest of code...
'// Some loop here I'm assuming...
lastCellChecked = "'" & WS.Name & "'!" & cell.Address
If cell.Value > 10 Then Exit Sub '// Lets assume this is classed as an error
'// Rest of loop here...
lastCellChecked = vbNullString
End Sub
The best way to do this is to create a userform and as mentioned by prior users create a public variable. When the program finds an error store the cell and initiate the userform. Your code will stop on the userform. When you're done checking the problem have a button on the userform that you can click to continue checking. Your loop can be something like the below.
public y as integer
sub temp1 ()
rw1= range("a500000").end(xlup).row 'any method to create a range will do
if y = null then y=1
for x = y to rw1
cells(x,1).select
'check for the problem your looking for
if errorX=true then
userform1.show
y = activecell.row
exit sub
end if
next x
end sub
What about inserting a button (on the sheet or in a menubar) for stopping?
Insert the code below:
'This at the top of the module
Public mStop As Boolean
'This in the module
Sub MyBreak()
mStop = True
End Sub
'This is your macro
Sub YourMacro()
'This at the top of your code
mStop = False
'Your code
'...
'This code where you want to break
DoEvents '<<<< This makes possible the stop
If mStop Then
mCont = MsgBox("Do you want to continue?", vbYesNo)
If mCont = vbNo Then
Exit Sub
Else
mStop = False
End If
End If
'Your code
'...
End Sub
Now you need to create a button and link it to the macro called "MyBreak".
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...