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
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
First time asking a question here, my apologies if my question has already been answered (If it was, I didn't understand it because I am an utter novice). My Excel userform that I use to update quantities of stock supplies used on a particular job is generating a
type mismatch error
It is supposed to add the quantity from the useform to the entry in the appropriate cell on the sheet. I assume that this has something to do with a variable not being declared correctly.
Private Sub SubmitFormButton_Click()
Dim Data_Start As Range
Dim i As Integer
Set Data_Start = ActiveSheet.Cells(6, 6)
For i = 1 To 31
Data_Start.Offset(i, 0) = Data_Start.Offset(i, 0) + AddToform.Controls("TextBox" & i).Value
Next i
Unload AddToform
End Sub
AddToform.Controls("TextBox" & i).Value is making a number of assumptions:
AddToForm was shown with AddToForm.Show. If you're doing this:
With New AddToForm
.Show
'...
End With
...then the code is not referring to the instance that's being displayed, and the .Value of the textbox is very likely not what you expect it to be, since the textbox you're reading from isn't the textbox that the user entered a value in.
There's a control named "TextBox" & i on the form. This means if you ever rename your textboxes to more meaningful names, e.g. FirstNameBox, LastNameBox (or whatever makes sense), then the code breaks. Using control names to hold metadata (e.g. some worksheet row number offset) can work, but it's probably better to iterate the controls on the form (whatever their names are), test if the current control is a TextBox (e.g. If TypeOf ctrl Is MSForms.TextBox Then), and then pull the metadata from the control's Tag property. That way your controls can have meaningful names and renaming them won't break any of the logic.
User input is valid. That's always a bad assumption to make, regardless of the language or technology being used: always protect your code from invalid input. If the user enters "ABC", that loop breaks. One way to do this, is to introduce a local variable, to separate getting the user input from consuming the user input - and validate it on the way:
If IsNumeric(Controls("TextBox" & i).Value) Then
Dim validInput As Double
validInput = CDbl(Controls("TextBox" & i).Value)
Data_Start.Offset(i, 0) = Data_Start.Offset(i, 0) + validInput
End If
And that should fix your bug.
I literally just got my feet wet with VBA as this is my first macro. After many hours of searching, I couldn't seem to find an answer that had a solution that worked for me so here I am.
On Sheet3 I have 3 option buttons in a group box that are linked to cell "B18" on Sheet4 (Sheet4 is hidden to the user, a backstage if you will). When any of the three option buttons are selected, 'Sheet4!B18' gets updated as it should (e.g. 1, 2, or 3). What I want to happen is to have 'Sheet3!B17' changed based upon the value in 'Sheet4!B18', or effectively: IF('Sheet4!B18'=2,SET('Sheet3!B17'="Some Text Here:"),SET('Sheet3!B17'="0%")), but still allow user input in 'Sheet3!B17'. I have one VBA macro on Sheet4 with the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Worksheet.Range("B18") = 2 Then
Worksheets("Sheet3").Range("B17") = "Some Text Here:"
Else
Worksheets("Sheet3").Range("B17") = "0%"
End If
End Sub
If I manually update 'Sheet4!B18' then the macro gets triggered with the desired results. If I use any of the 3 option buttons on Sheet3, the macro does not get triggered even though the target cell is getting updated.
In my searching I couldn't seem to find anything concrete, but from what I could tell the "Worksheet_Change" function doesn't see changes to cells from form control as changes to the linked cell are considered a "recalculation" as if it were from a formula. I don't know how correct that is, but my searching led me to believe that I would need another macro assigned on the 3 buttons and/or group box that when either of those get selected/changed, it would somehow trigger the working macro on Sheet4.
I thought that perhaps I could create a new macro that I would assign to the group box or option buttons themselves so I tried that and could not get anything to work. I tried adding the above macro code to another sub, Sub mode() and assigning to only the group box, then only the buttons, but nothing happened in either case. I proceeded to try tweaking the code just in case the references were not correct, but saw no change regardless of how I specified the reference. I am not getting any error messages, but nothing gets triggered unless I manually change the value in 'Sheet4!B18'.
Is there a way to get the first macro that I have working on Sheet4 to trigger off of the option buttons changing the target cell value, something like forcing it to look only at that one specific cell for changes? Am I stuck making another macro for the buttons and/or group box to trigger the macro on Sheet4? Am I over-complicating this and there is some built in Excel sheets function(s) that I can use?
IF/THEN is a fine way to do it. VBA also supports ternary logic with the IIF function, like this:
Worksheets("Sheet3").Range("B17") = IIF(Worksheets("Sheet4").Range("B18") = 2, "Some Text Here:", "0%")
That may seem a little difficult to read, but it's a good concept to understand, since it's present in many languages, and usually with a more simplified implementation that makes it very useful and concise.
Also, I would suggest making a couple of other alterations that may make your code easier to write, read and maintain (especially as it becomes more complex).
First, alias the worksheets, something like this:
Dim this as Worksheet: Set this = Worksheets("Sheet3")
Dim that as Worksheet: Set that = Worksheets("Sheet4")
Now you would be able to rewrite your code like this:
If that.Range("B18") = 2 Then
this.Range("B17") = "Some Text Here:"
Else
this.Range("B17") = "0%"
End If
And the ternary approach would now be:
this.Range("B17") = IIF(that.Range("B18") = 2, "Some Text Here:", "0%")
And you can get as specific as you like with the aliases. For instance, you could realias the ranges, instead of just the worksheets, like this:
Dim this as range: Set this = Worksheets("Sheet3").Range("B17")
Dim that as range: Set that = Worksheets("Sheet4").Range("B18")
this = IIf(that = 2, "Some Text Here:", "0%")
Also, I find it easier to use the cells property than the range property, especially when you start having to do cell math. In that case, Range("B17") becomes Cells(17, 2).
You can also change the way the cells are referenced in the spreadsheet by typing Application.ReferenceStyle = xlR1C1 into the immediate window. That way you don't have to mentally convert between A2 style ranges to Cartesian style (2,1).
Sometimes you just have to go through your entire thought process and type everything out before you have an "ah-hah!" moment because that is exactly what I had happen. I said to myself, "Why can't I have just one macro that gets triggered by the option buttons that checks my linked cell then proceeds to update the cell I want?" Well, eventually I was able to find the right code and this is what worked perfectly:
Sub mode() ' mode is the name of this macro
If Worksheets("Sheet4").Range("B18") = 2 Then
Worksheets("Sheet3").Range("B17") = "Some Text Here:"
Else
Worksheets("Sheet3").Range("B17") = "0%"
End If
End Sub
As it turns out, I was overlooking the simple solution and the above macro is all I need once I assigned it to the 3 option buttons in my group box, but not the group box itself. Since users will not have access to the hidden Sheet4 and therefore 'Sheet4!B18' will never have manual user input, the macro I first had on Sheet4 could be removed safely. Due to the fact that the option buttons being chosen is the trigger for the assigned macro, it executes each time the option is changed and only when the option is changed. Perfect!
EDIT:
Thanks to Chris Strickland for some tips for better code! I went on to modify the above into what you see below for slightly better performance (using Cells() instead of Range()), to save the original value to another cell and restore it if option 1 or 3 were selected, used aliases, and finally the IIf operator.
Sub mode() ' mode is the name of this macro
Dim S3 As Worksheet: Set S3 = Worksheets("Sheet3")
Dim S4 As Worksheet: Set S4 = Worksheets("Sheet4")
If IsNumeric(Cells(17, 2)) = True Then
S3.Activate
S4.Cells(18, 3) = Cells(17, 2).Value
End If
S3.Cells(17, 2) = IIf(S4.Cells(18, 2) = 2, "Some Text Here:", S4.Cells(18, 3))
End Sub
Sub sampleButton_Click()
On Error GoTo ErrorHandler
With Selection.ShapeRange
If .Type = msoGroup Then
Call setStyleTest(.GroupItems(.GroupItems.Count))
Else
For Each shp In ActiveWindow.Selection.ShapeRange
Call setStyleTest(shp)
Next shp
End If
End With
Exit Sub
ErrorHandler:
MsgBox "Error", vbExclamation
End Sub
I use ActiveX CommandButton and have a problem with a testing selection of ShapeRange. What should I change/fix?
Thanks in advance
Problem Explanation
The CommandButton does not have the property ShapeRange
Hence, the error will always arise
In the other hand, if you change the object for a button -the one under form collection- you will not have that problem because that property exists in that object
Note that, even if they resemble in appearance, they are totally different objects, as such, one property may not exist in the other one or behave like in the other.
More info about what you can do -and how to do it- with this button can be found here
Solution/workaround
I can see that you are calling another sub to "personalize" the button created, since it is unknown, you would need to change in that according to the object in order to provide the desired format.
You would also need to invert the order in your code for the correct handling
...
If .Type = msoGroup Then
With Selection.ShapeRange
...
Further thoughts
I cannot possible think about a scenario where you would need to use active X instead of form button collection, so I would suggest to change all the buttons to that.
It is working just fine for me
The value of msoGroup is 6
Till the time the group is selected your code will work. Once you are out of design mode and the group is not selected, your code will not work.
And yes the above two command buttons are ActiveX and not Form Controls
My suggestion: Stick to Form controls.
I am trying to make a maths practice powerpoint where students are presented with random addition problems using numbers 1 – 20. I have been working through tutorials by David Marcovtiz (and others) and was using his code as a starting point. As my audience is young students, I would like the maths problems to not be in a message box but in something like text boxes or shapes that I can customise and make large and visually appealing for young students.
So, what I'm wanting to do...
In a powerpoint show
Student can click a ‘get started’ button that takes them to next slide
Next slide automatically generates 2 random numbers that student must add together.
Student enters the answer
If answer is correct – I would like something to signify the answer was correct but not something they have to click on to close. Ideally, a little star flashes in the corner then disappears
If the answer is incorrect, a message or picture flashes then disappears.
A new addition problem is automatically/randomly generated
I would like to set the number of addition problems to e.g. 20, then have the slide move to a scoring slide that shows their score in pictures e.g. a star for every correct answer.
Update:
Using Activex text Boxes:
I have had success with activex text boxes in being able to randomly show two numbers and have them multiply and show the answer in a third activex text box, which I hid off the slide. I used a fourth as an input box for students to type in their answer. If this is the same as the answer in the third box, I can show a star and clear the boxes then move to the next slide. If it's not the same, I can go show another picture then move to the next slide. (I originally wanted the slide to update and use one slide to ask 20 questions but was finding this difficult.)
At present, this requires clicking three command buttons.
What I have managed so far (I know it will seem quite sad to you and possibly unstable, but a major achievement for me and the 'bits' are working) I can manage it for multiplication but when I + the values e.g. 9 + 3, I get 93
Private Sub CommandButton1_Click()
TextBox1.Value = Int(10 * Rnd)
TextBox2.Value = Int(10 * Rnd)
TextBox3.Value = TextBox1.Value * TextBox2.Value
End Sub
Private Sub CommandButton2_Click()
If TextBox4.Value = TextBox3.Value Then
ActivePresentation.Slides("problem").Shapes("badge5").Visible = True
ActivePresentation.Slides("score").Shapes("badge5").Visible = True
Else
ActivePresentation.Slides("problem" _).Shapes("incorrect").Visible = True
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
End If
End Sub
Private Sub CommandButton3_Click()
SlideShowWindows(1).View.Next
End Sub
What I need
I would like the random numbers in command button 1 to activate automatically.
I would like to combine command button 2 and 3 and include a wait time after the star or incorrect shapes appear before moving to the next slide but the code I have found applies the wait time to the whole sequence as I'm not sure how to include it.
Private Sub Time_Click()
iTime = 2#
Start = Timer
While Timer < Start + iTime
Wend
With SlideShowWindows(1).View.Next
End With
End Sub
Using Shapes:
I would prefer to work with ordinary text boxes or shapes but...
I have managed to produce random numbers in shapes but haven't been able to multiply them and have students type into an activex text box that determines whether it is correct or incorrect yet. I think the problem is in trying to use both shapes and an activex textbox.
I would like to use shapes because I would like to create master slide layouts that can be selected using the following code - though this isn't a deal breaker.
Sub background()
ActivePresentation.Slides.Range(Array(2, 3, 4, 5)).CustomLayout_
= ActivePresentation.Designs(1).SlideMaster.CustomLayouts(6)
End Sub
I feel this is something that other educators could use and am happy to post my finished show if someone is willing and able to assist with the coding. I really appreciate the tolerance and patience of contributors shown to people like myself who have jumped in head first, excited and giving it a go but struggling.
So, to break down the pieces you requested in the "What I Need" section, I will split my answer into two sections:
"I would like the random numbers in command button 1 to activate automatically."
I assume what you mean by "automatically" is that you would like the "next" slide to automatically be populated with values after the user answers the question on the previous slide. To accomplish this functionality, I would call the method that the CommandButton1 currently calls after all the logic in the CommandButton2 has been run.
"I would like to combine command button 2 and 3 and include a wait time after the star or incorrect shapes appear before moving to the next slide..."
I would simply combine the code of the two functions with a wait function in between the two bits of code. I'm not sure where you found the code you posted for the "Timer_Click" function, I don't think that would work as currently posted. I would typically use the method of "wait" mentioned in this answer.
The result, after changing the code for the two new requirements would be something like this:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub CommandButton2_Click()
'Command Button 2(code)
If TextBox4.value = TextBox3.value Then
ActivePresentation.slides("problem").Shapes("badge5").visible = True
ActivePresentation.slides("score").Shapes("badge5").visible = True
Else
ActivePresentation.slides("problem").Shapes("incorrect").visible = True
TextBox1.value = ""
TextBox2.value = ""
TextBox3.value = ""
TextBox4.value = ""
End If
'Wait code here(1000ms)
Sleep 1000
'Command Button 3(code)
SlideShowWindows(1).View.Next
'Call the command for CommandButton1,
'this will "automatically" populate the slide with new values
CommandButton1_Click
End Sub