I am trying to create a macro in VBA with Visio, that would count the amount of shapes in a layer and report the number. Would anyone have any ideas or pointers on how to approach this?
I know how to report the number of shapes in a entire workbook but I'm needing to report the quantity in a layer to see if it even has items assigned to it. I thought something like Layers.count would work but I'm not sure if that's even the correct way.
You can use the CreateSelection method on Page and then return the count from that.
For example:
Public Sub GetTheCount()
Dim layerName As String
Dim count As Integer
layerName = "Flowchart"
count = CountShapesOnLayer(ActivePage, layerName)
Debug.Print "There are " & count & " shapes on layer " & layerName
End Sub
Public Function CountShapesOnLayer(ByRef vPag As Visio.Page, layerName As String) As Integer
If Not vPag Is Nothing Then
Dim vLayer As Visio.Layer
Dim vSel As Visio.Selection
Set vLayer = vPag.Layers.ItemU(layerName)
Set vSel = vPag.CreateSelection(Visio.VisSelectionTypes.visSelTypeByLayer, _
Visio.VisSelectMode.visSelModeSkipSuper, _
vLayer)
CountShapesOnLayer = vSel.count
Else
CountShapesOnLayer = 0
End If
End Function
Note the SelectMode argument, which in the above will give you the top level shapes, but bear in mind that you may need to change this if you're dealing with sub-shapes (in a group).
Related
I tried reading other posted questions about this error but I am still having trouble understanding it.
I was having errors after renaming variables and posted this question, I use option explicit and debug my code and it fixed my naming problems, But I still am having one problem in that 2 out of my 21 comboboxes in the operations row are still getting this same error. How can they get an error when they are using the same functions as the other 19. I checked their names and they are correct how could this be??
I have a form that I have build that is set up to look and function similar to and excel spreadsheet. This is the layout, Column Names first and then Control type
Operation Time/Min DecTime LaborRate Cost MarkUp Total
ComboBox TextBox Label Label Label TextBox Label
So all together I have 7 columns with 21 rows (not including column names) in which I can input data. Any where there is a label there is no user input its value is simply derived from the other fields.
I used the following naming convention for my form controls cb_op1, cb_op2, cb_op3 ... I just increment it by one to mimic the row number (control name plus row number). Operation = cb_op, Time = tb_time, DecTime = tb_Dectime, LaborRate = tb_LbrRate, Cost = tb_Cost, MarkUp = tb_MU, Total = tb_Total.
I wrote functions for the AfterUpdate events for my controls. This first function gets the value of the control based on its row number and then allows me to assign it to a variable this fuction is used for multiple controls update events.
Private Function GetControlValue(name As String) As Object
Dim obj As Object
For Each obj In Me.Controls
If obj.name = name Then
Set GetControlValue = obj
Exit Function
End If
Next
End Function
The next function is used to actually update the other field in the row based on the after update event. I use the GetControlValue Function listed above in this function. This is just for the operations column.
Private Function OperationsUpdate(RowNumber As Integer)
Dim Operations As Object
Dim Time As Object
Dim DecTime As Object
Dim LaborRate As Object
Set Operations = GetControlValue("cb_op" & RowNumber)
Set Time = GetControlValue("tb_time" & RowNumber)
Set DecTime = GetControlValue("tb_DecTime" & RowNumber)
Set LaborRate = GetControlValue("tb_LbrRate" & RowNumber)
Set Cost = GetControlValue("tb_Cost" & RowNumber)
If IsNull(Time.Value) Then
If IsNull(Operation.Value) Then
Cost.Value = ""
LaborRate.Value = ""
Else
LaborRate.Value = DLookup("LaborRate", "OperationsType", "[operationsID] = " & Operation.Value)
End If
Else
If IsNull(Operation.Value) Then
Cost.Value = ""
LaborRate.Value = ""
Else
LaborRate.Value = DLookup("LaborRate", "OperationsType", "[operationsID] = " & Operation.Value)
Cost.Value = DecTime.Value * LaborRate.Value
End If
End If
FormObjectsUpdate2 (RowNumber)
Set Operations = Nothing
Set Time = Nothing
Set DecTime = Nothing
Set LaborRate = Nothing
Set Cost = Nothing
End Function
Finally this is how my After update events look per control. I post just the first three not all 21 to save space.
Private Sub cb_op1_AfterUpdate()
OperationsUpdate (1)
End Sub
Private Sub cb_op2_AfterUpdate()
OperationsUpdate (2)
End Sub
Private Sub cb_op3_AfterUpdate()
OperationsUpdate (3)
End Sub
I just posted the function and the code for the first column operations all the other after update events are now having the same issues too.
I need to set a parent Control to another control using the VBA code.
Actually i am looping to create differents controls dynamically and i want now to link them by child-parent.
Do someone has an idea ?
Here is the function where i create a new control and i set some values. And the last assignment is where i want to set the parent
Public Function apply_change(ihm_f, oNode, iMyName$, project$)
Dim new_elem
Dim oSubNodes As IXMLDOMNode
If oNode.Attributes.getNamedItem("Type").Text <> "Page" Then
If (oNode.Attributes.getNamedItem("Type").Text = "RefEdit") Then
Set new_elem = ihm_f.Designer.Controls.Add("RefEdit.Ctrl", oNode.nodeName, True)
Else
Set new_elem = ihm_f.Designer.Controls.Add("Forms." & oNode.Attributes.getNamedItem("Type").Text & ".1", oNode.nodeName, True)
End If
With new_elem
On Error Resume Next
.Width = oNode.Attributes.getNamedItem("Width").Text
.Top = oNode.Attributes.getNamedItem("Top").Text
.Left = oNode.Attributes.getNamedItem("Left").Text
.Height = oNode.Attributes.getNamedItem("Height").Text
Set .Parent = get_parent(oNode.ParentNode.nodeName, oNode, ihm_f)
End With
If oNode.Attributes.getNamedItem("Type").Text = "MultiPage" Then
Call new_elem.Pages.Remove(0)
Call new_elem.Pages.Remove(0)
For Each oSubNodes In oNode.ChildNodes()
Call new_elem.Pages.Add(oSubNodes.BaseName, oSubNodes.Attributes.getNamedItem("Caption").Text, oSubNodes.Attributes.getNamedItem("Index").Text)
Next oSubNodes
End If
End If
Set apply_change = ihm_f
End Function
The getparent function return a Controle which can be anything .. like textbox or combo box etc..
You provide so little information in your question that it is difficult to guess your objective.
However, I am guessing that you want to record that Control Xxxxx is the parent of control Yyyyy where the definition of “parent” has nothing to do with Excel’s definition of parent. I am further guessing you do not know how to access controls by number.
The macro below lists the name, type and top position of every control on a form by its index number within the collection Controls. Any property of a control is accessible in this way. If control Xxxxx is the parent of control Yyyyy, you can scan the collection to find their index numbers when the form loads and record this information for use when required.
Private Sub UserForm_Initialize()
Dim InxCtrl As Long
Dim LenNameMax As Long
Dim LenTypeMax As Long
LenNameMax = 0
For InxCtrl = 0 To Controls.Count - 1
If LenNameMax < Len(Controls(InxCtrl).Name) Then
LenNameMax = Len(Controls(InxCtrl).Name)
End If
If LenTypeMax < Len(TypeName(Controls(InxCtrl))) Then
LenTypeMax = Len(TypeName(Controls(InxCtrl)))
End If
Next
Debug.Print PadR("Name", LenNameMax) & "|" & PadR("Type", LenTypeMax) & "| Top"
For InxCtrl = 0 To Controls.Count - 1
Debug.Print PadR(Controls(InxCtrl).Name, LenNameMax) & "|" & _
PadR(TypeName(Controls(InxCtrl)), LenTypeMax) & "|" & _
PadL(Format(Controls(InxCtrl).Top, "#,###.00"), 8)
Next
End Sub
I have a PowerPoint slide with 5 shapes on it. I would like to do different things with theses shapes in a macro. How can I change one of these shapes by using the shape ID? For example, I have two shapes with a name of "Title 1" but I want to use the one with an ID of 15.
Here is my code:
Sub size_n_spread_v()
Dim j As Integer
Dim sld As Slide
Dim SldId As Long
gap = std_gap
SldId = ActiveWindow.View.Slide.SlideIndex
Set sld = ActivePresentation.Slides(SldId)
Call SortMultArray
new_dim = (total_dim - gap * (lngRow - 1)) / lngRow
'This works but is not specific:
'sld.Shapes.("Title 1").Height = new_dim
'This would hopefully be specific but the syntax does not work Please HELP!
'sld.Shapes.("Title 1").Id(15).Height = new_dim
End Sub
Does someone know the right syntax to change the shape via ID?
I don't know of a way, but you could write a simple helper function that you could then use throughout your project to make things easier on yourself. Something like this would work:
Public Function GetShapeById(s As Slide, n As String, id As Long) As Shape
Dim objShape As Shape
For Each objShape In s.Shapes
If StrComp(objShape.Name, n, vbTextCompare) = 0 And objShape.Id = id Then
Set GetShapeById = objShape
Exit Function
End If
Next
End Function
Then you could use it like so:
Sub size_n_spread_v()
....
' Instead of:
sld.Shapes.("Title 1").Id(15).Height = new_dim
' Use:
GetShapeById(sld, "Title 1", 15).Height = new_dim
End Sub
The function mentioned above is the only way to get a shape by Id. You have to search through the Shapes collection as there is no equivalent ShapeIndex as there is for SlideIndex. The other solution to find a specific shape is to uniquely identify shapes by adding your own Tag but this is a more complex solution.
I'm learning for loop and I cannot get this problem fixed.
The problems are in the following codes.
dim rt as integer = 2
dim i As Integer = 0
dim currentpg as string = "http://homepg.com/"
For i = 0 To rt
currentpg = currentpg & "?pg=" & i
messagebox.show(currentpg)
next
'I hoped to get the following results
http://homepg.com/?pg=0
http://homepg.com/?pg=1
http://homepg.com/?pg=2
'but instead I'm getting this
http://homepg.com/?pg=0
http://homepg.com/?pg=0?pg=0
http://homepg.com/?pg=0?pg=0?pg=0
Please help me
Thank you.
You probably need something like this:
Dim basepg as string = "http://homepg.com/"
For i = 0 To rt
Dim currentpg As String = basepg & "?pg=" & i
messagebox.show(currentpg)
Next
Although a proper approach would be to accumulate results into a List(Of String), and then display in a messagebox once (or a textbox/file, if too many results). You don't want to bug user for every URL (what if there are 100 of them?). They would get tired of clicking OK.
First of all, you went wrong while copying the output of the buggy code. Here is the real one.
http://homepg.com/?pg=0
http://homepg.com/?pg=0?pg=1
http://homepg.com/?pg=0?pg=1?pg=2
It does not work because currentpg should be a constant but it is changed on each iteration.
Do not set, just get.
MessageBox.Show(currentpg & "?pg=" & i)
Or you can use another variable to make it more readable.
Dim newpg As String = currentpg & "?pg=" & i
MessageBox.Show(newpg)
Also, your code is inefficient. I suggest you to change it like this.
Dim iterations As Integer = 2
Dim prefix As String = "http://homepg.com/?pg="
For index As Integer = 0 To iterations
MessageBox.Show(prefix & index)
Next
before I start I want to point out that I tagged this question as VBA because I can't actually make a new tag for Winwrap and I've been told that Winwrap is pretty much the same as VBA.
I'm working on SPSS V19.0 and I'm trying to make a code that will help me identify and assign value labels to all values that don't have a label in the specified variable (or all variables).
The pseudo code below is for the version where it's a single variable (perhaps inputted by a text box or maybe sent via a custom dialogue in the SPSS Stats program (call the .sbs file from the syntax giving it the variable name).
Here is the Pseudo Code:
Sub Main(variable As String)
On Error GoTo bye
'Variable Declaration:
Dim i As Integer, intCount As Integer
Dim strValName As String, strVar As String, strCom As String
Dim varLabels As Variant 'This should be an array of all the value labels in the selected record
Dim objSpssApp As 'No idea what to put here, but I want to select the spss main window.
'Original Idea was to use two loops
'The first loop would fill an array with the value lables and use the index as the value and
'The second loop would check to see which values already had labels and then
'Would ask the user for a value label to apply to each value that didn't.
'loop 1
'For i = 0 To -1
'current = GetObject(variable.valuelist(i)) 'would use this to get the value
'Set varLabels(i) = current
'Next
'Loop for each number in the Value list.
strValName = InputBox("Please specify the variable.")
'Loop for each number in the Value list.
For i = 0 To varLabels-1
If IsEmpty (varLabels(i)) Then
'Find value and ask for the current value label
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
'Apply the response to the required number
strCom = "ADD VALUE LABELS " & strVar & Chr$(39) & intCount & Chr$(39) & Chr$(39) & strValName & Chr$(39) &" ."
'Then the piece of code to execute the Syntax
objSpssApp.ExecuteCommands(strCom, False)
End If
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
Next
Bye:
End Sub
This is in no way functioning code, it's just basically pseudo code for the process that I want to achieve I'm just looking for some help on it, if you could that would be magic.
Many thanks in advance
Mav
Winwrap and VBA are almost identical with differences that you can find in this post:
http://www.winwrap.com/web/basic/reference/?p=doc_tn0143_technote.htm
I haven't used winwrap, but I'll try to answer with my knowledge from VBA.
Dim varLabels As Variant
You can make an array out of this by saying for example
dim varLabels() as variant 'Dynamically declared array
dim varLabels(10) as variant 'Statically declared array
dim varLabels(1 to 10) as variant 'Array starting from 1 - which I mostly use
dim varLabels(1 to 10, 1 to 3) 'Multidimensional array
Dim objSpssApp As ?
"In theory", you can leave this as a variant type or even do
Dim objSpssApp
Without further declaration, which is basically the same - and it will work because a variant can be anything and will not generate an error. It is good custom though to declare you objects according to an explicit datatype in because the variant type is expensive in terms of memory. You should actually find out about the objects class name, but I cannot give you this. I guess that you should do something like:
set objSpssApp = new <Spss Window>
set objSpssApp = nothing 'In the end to release the object
Code:
'loop 1
For i = 0 To -1
current = GetObject(variable.valuelist(i)) 'would use this to get the value
Set varLabels(i) = current
Next
I don't exactly know why you want to count from 0 to -1 but perhaps it is irrelevant.
To fill an array, you can just do: varLabels(i) = i
The SET statement is used to set objects and you don't need to create an object to create an array. Also note that you did not declare half of the variables used here.
Code:
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
Note that the concatenation operator syntax is &.
This appears to be the same in WinWrap:
http://www.winwrap.com/web/basic/language/?p=doc_operators_oper.htm
But you know this, since you use it in your code.
Code:
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
I'm not sure if I understand this question, but in theory all loops are valid in any situation, it depends on your preference. For ... Next, Do ... Loop, While ... Wend, in the end they all do basically the same thing. intCount = intCount + 1 seems valid when using it in a loop.
Using Next (for ... next)
When using a counter, always use Next iCounter because it increments the counter.
I hope this reply may be of some use to you!