Can I get the name of the layer a connector is assigned to in vba?
I am doing this with shapes like this
ActivePage.Shapes(1).layer(1)
And now I am looking for something similar but for connectors.
I'm not completely clear on your issue, but there's nothing special about connectors - they're still just shapes. So if you know the index of your target shape and layer, then you can use your code above.
Shapes in Visio can also belong to multiple layers (layers don't work in the same way as, say, Photoshop), so you might want to get the layer count first and then run through each one. For example:
Sub CheckLayers()
Dim shp As Visio.Shape
Dim i As Integer
For Each shp In ActivePage.Shapes
Debug.Print shp.NameU
For i = 1 To shp.LayerCount
Debug.Print " " & shp.Layer(i).Name
Next i
Debug.Print ""
Next shp
End Sub
Also, depending on what you're trying to do, you might want to take advantage of the Page.CreateSelection method to return a selection based on shapes on a particular layer. Here's a very slightly modified version from the Visio SDK:
Public Sub CreateSelection_Layer_Example()
Dim vsoLayer As Visio.Layer
Dim vsoSelection As Visio.Selection
Set vsoLayer = ActivePage.Layers.ItemU("Connector")
Set vsoSelection = ActivePage.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, vsoLayer)
'Note that you don't have to pass the selection object to
'the ActiveWindow Selection property - you can just work
'with it directly if you want to
Application.ActiveWindow.Selection = vsoSelection
End Sub
If you're using the Dynamic Connector, this gets automatically assigned to a layer called 'Connector'.
Related
I've written some code that formats text. The code doesn't work if user has put the cursor in a shape that is part of a group of shapes, the solution for which is to ungroup the shapes.
I want to regroup the shapes after executing the formatting code.
I am able to store the underlying shapes as objects, as well as their names. But, the normal approach to grouping (using shape names) doesn't work, because there can be multiple instances of those shape names on a given slide. E.g. this doesn't work as there could be multiple instances of "textbox" on the slide:
Set TempShapeGroup = TempSlide.Shapes.Range(Array("textbox", "header", "separator")).Group
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.shaperange.group
But, I have the shape objects stored in an array, the crux of which is this (the object 'TempShape' is the group of shapes):
Dim ShapesArray() As Shape
ReDim ShapesArray(1 To TempShape.GroupItems.Count)
For i = 1 To TempShape.GroupItems.Count
Set ShapesArray(i) = TempShape.GroupItems.Item(i)
Next i
So, what I want to do is recreate the group of shapes, using the array of shape objects, so something to the effect of the below would be ideal:
Set MyShapesGroup= ShapesArray.Group
But any way to group shapes using Shape objects would be fine.
TIA
Here's some starter code that you can modify into a function that'll return a reference to the paragraph that contains the current selection cursor. It doesn't really need all the debug.print stuff, of course, but that might help to illustrate the object hierarchy:
Sub WhereIsTheCursor()
Dim oRng As TextRange
Dim oParentRange As TextRange
Dim x As Long
Dim lSelStart As Long
Dim lSelLen As Long
With ActiveWindow.Selection.TextRange
' find the selection start relative to first character in shape
lSelStart = .Start
' lSelLen = .Length
Debug.Print TypeName(.Parent)
Debug.Print TypeName(.Parent.Parent)
Debug.Print TypeName(.Parent.Parent.Parent)
Debug.Print .Paragraphs.Count
Set oRng = .Characters(.Start, .Length)
Debug.Print oRng.Text
' Reference the overall shape's textrange
Set oParentRange = .Parent.Parent.TextFrame.TextRange
' For each paragraph in the range ...
For x = 1 To oParentRange.Paragraphs.Count
' is the start of the selection > the start of the paragraph?
If lSelStart > oParentRange.Paragraphs(x).Start Then
' is the start < the start + length of the paragraph?
If lSelStart < oParentRange.Paragraphs(x).Start _
+ oParentRange.Paragraphs(x).Length Then
' bingo!
MsgBox "The cursor is in paragraph " & CStr(x)
End If
End If
Next
End With
End Sub
Not sure I'm completely understanding the problem, but this may help:
If the user has selected text within a shape, it doesn't really matter whether the shape is part of a group or not. You may need to test the .Selection.Type and handle things differently depending on whether the .Type is text or shaperange. Example:
Sub FormatCurrentText()
If ActiveWindow.Selection.Type = ppSelectionText Then
With ActiveWindow.Selection.TextRange
.Font.Name = "Algerian"
End With
End If
End Sub
I would like to simplify updating my orgcharts in Visio. So far I have a macro borrowed from here https://bvisual.net/2010/01/28/applying-selected-datagraphic-to-the-whole-document/ and written out below. I would like to adapt it to make some changes to the format of the text withing shapes e.g. to make the font bold and potentially to change it's colour. I'm finding it really difficult to find examples of this online so any help/suggestion would be greatly appreciated.
Public Sub ApplyDataGraphicToDocument()
Dim mstDG As Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.Page
Dim firstProp As String
If Visio.ActiveWindow.Selection.Count = 0 Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
Set shp = Visio.ActiveWindow.Selection.PrimaryItem
If shp.DataGraphic Is Nothing Then
MsgBox "Please select a shape which already has data graphics"
Exit Sub
Else
'Get the shapes DataGraphic master
Set mstDG = shp.DataGraphic
'Get the name of the first Shape Data row
firstProp = "Prop." & _
shp.CellsSRC(Visio.visSectionProp, 0, 0).RowNameU
End If
End If
For Each pag In Visio.ActiveDocument.Pages
If pag.Type = visTypeForeground Then
For Each shp In pag.Shapes
'Check that the named Shape Data row exists
If shp.CellExistsU(firstProp, Visio.visExistsAnywhere) Then
'Set the DataGraphic
shp.DataGraphic = mstDG
End If
Next
End If
Next
End Sub
You can modify the default OrgChart shapes, although it is not officially supported. To change the default shapes (make their font bold), you'll need to edit the templates (masters) for those OrgChart shapes. In the same blog you can find more information on customizing the OrgChart diagrams, here: https://bvisual.net/2012/05/08/creating-a-custom-org-chart-template-with-extra-properties
The procedure is mostly the same, just instead of adding the properties, you make the text bold.
I want to highlight the shape corresponding to a particular group. The following code is only highlighting shapes that are grouped with active page or master but not with the group present in the active page.
Sub CA_Trace_Conflict1()
PCC_CA = InputBox("Enter PCC Band")
'SCC1_CA = InputBox("Enter SCC1 Band")
Dim shp As Visio.Shape
Dim subshp As Visio.Shape
Dim connectorshape As Visio.Shape
Dim BandLinewidth As String
Dim lngShapeIDs() As Long
Dim count As Integer
Dim PCC_Flag As Integer
Dim SCC1_Flag As Integer
PCC_Flag = 0
SCC1_Flag = 0
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Dim UndoScopeID1 As Long
PCC_CA_space = PCC_CA & " "
For Each shp In Visio.ActivePage.shapes
If shp.Type = 2 Then 'Check if shp is a group
For Each subshp In shp.shapes
If InStr(shp.Text, PCC_CA_space) > 0 Then
'If PCC_CA Like shp.Text Then
Set connectorshape = shp
Debug.Print shp.Parent
Application.ActiveWindow.Page.shapes.ItemFromID(shp.ID).CellsSRC(visSectionObject,visRowLine, visLineWeight).FormulaU = "5.5 pt"
' Debug.Print shp.ID
End If
Next
End If
Next
End Sub
I think you want to select a subshape within a group programmatically. Doing this in Visio is not obvious, so let me help. I'll put links to two articles on my website, plus one on Microsoft's at the end of the post. These discuss selection-related topics in further detail.
So let's tackle your problem...
Setup
Open a blank drawing in Visio
Draw two rectangles, then group them
You now have three shapes on this page.
Sheet.1 is a subshape
Sheet.2 is a subshape
Sheet.3 is the group
You can programmatically select the group like this, as you've discovered:
Public Sub SelectGroup()
'// Get the active window:
Dim win As Visio.Window
Set win = Visio.ActiveWindow
'// Deselect everything:
Call win.DeselectAll
'// Get a shape object:
Dim shp As Visio.Shape
Set shp = Visio.ActivePage.Shapes.ItemFromID(3) '<<----- Sheet.3 is the group!
'// Cause that shape to be selected in the window:
Call win.Select(shp, Visio.VisSelectArgs.visSelect)
'// Cleanup:
Set shp = Nothing
Set win = Nothing
End Sub
By the way, the Sub above is much more nitpicky and long than it has to be. But it will help to have things simple and clean, when you start adding features and behaviors. You can actually one-line the whole procedure like this--you can even paste this into the Immediate window:
Call Visio.ActiveWindow.Select(Visio.ActivePage.Shapes.ItemFromID(3), Visio.VisSelectArgs.visDeselectAll + Visio.VisSelectArgs.visSelect)
Now to subselect Sheet.1 or Sheet.2. One would think we could simply change the shp object to be one of the subshapes, ala:
'// Sheet.1 is a subshape, you'll get an error
Set shp = Visio.ActivePage.Shapes.ItemFromID(1) '<<----- ID = 1
but this won't work. In fact you'll get an "Inappropriate target object for this action" error.
To fix this, we have to pass a different argument to the Select method:
Public Sub SelectSubshape()
'// We've drawn two rectangles on a blank page, then
'// grouped them. Sheet.1 and Sheet.2 are subshapes,
'// Sheet.3 is the group.
'// Get the active window:
Dim win As Visio.Window
Set win = Visio.ActiveWindow
'// Deselect everything:
Call win.DeselectAll
'// Get a subshape object:
Dim shp As Visio.Shape
Set shp = Visio.ActivePage.Shapes.ItemFromID(2)
'// Cause that shape to be SUBSELECTED in the window.
'// Note the different argument: visSubSelect
Call win.Select(shp, Visio.VisSelectArgs.visSubSelect) ' <<------ visSubSelect!
'// Cleanup:
Set shp = Nothing
Set win = Nothing
End Sub
Voila! Subshape selected in the active window!
If you want to detect which shapes are already selected, then you'll have to fiddle with the IterationMode property of a Selection object. This is pretty confusing, plus I don't think you're asking for that right now. But knowing the term will help you search for help in the future, should you need it.
Articles
Getting a Handle on Selecting and Subselecting Visio Shapes
Detect Sub-selected Shapes Programmatically
Selection.Select method (Visio)
I am new to VBA and this is my first assignment, involving a pre-existing Visio drawing.
The Visio drawing consists of several shapes and I ultimately want a way to detect which shapes are cables (two "connector" shapes that are attached by a dynamic connector) using vba code. To do this,
1) I want to start by storing all the shape names in an array.
2) Then, I want to cross-check that array with know names of connector shapes and create a new array of just those connector shapes.
3) Next, I would check what each connector shape is connected to and that would allow me to determine what type of cable it is (I have this part of the code complete).
4) Finally, I would assign the cable's # to one of the connector shapes (I think I have working code for this too).
I am trying to figure out how to implement Steps 1 and 2 with my existing code.
Currently I am only able to detect connected shapes when one of those shapes is selected:
Public Sub ConnectedShapes()
' Get the shapes that are at the other end of
' incoming connections to a selected shape
Dim vsoShape As Visio.Shape
Dim allShapes As Visio.Shapes
Dim lngShapeIDs() As Long
Dim intCount As Integer
If ActiveWindow.Selection.Count = 0 Then
MsgBox ("Please select a shape that has connections.")
Exit Sub
Else
Set vsoShape = ActiveWindow.Selection(1)
End If
Set allShapes = ActiveDocument.Pages.Item(1).Shapes
lngShapeIDs = vsoShape.ConnectedShapes(visConnectedShapesAllNodes, "")
Debug.Print " Shape selected: ";
Debug.Print vsoShape
Debug.Print " Shape(s) connected: ";
For intCount = 0 To UBound(lngShapeIDs)
connectedItem = allShapes.ItemFromID(lngShapeIDs(intCount)).Name
Debug.Print connectedItem
If InStr(1, vsoShape, "USB A - top") = 1 Then
If InStr(1, connectedItem, "USB A Female") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB Mini B") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB Micro B") = 1 Then
' write cable's number
ElseIf InStr(1, connectedItem, "USB C Male") = 1 Then
' write cable's number
End If
End If
Next
End Sub
Is there a built-in function for Visio vba that would help me implement steps 1 & 2? What's the easiest way to find all the shapes in the document and store them in an array?
Understanding your desired business logic is the first step. Your steps 1 & 2 can be a single step.
Understanding your solution space is about understanding the range of tools a programming language gives you. In this case it is about how to efficiently loop (e.g. For Each) and information containers (e.g. Collection).
Here is some example code:
Option Explicit ' Always use this at the top of a module. Always.
Function ExampleFindShapes(chosenPage as Page) as Collection
Dim foundShapes as New Collection ' Note the new part, this initialised the Collection
Dim shapeLoopIterator as Shape
Dim arrayLoopIterator as Long
Dim validShapes as Variant
validShapes = Array("Bob", "Harry", "George")
For each shapeLoopIterator in chosenPage.Shapes ' One way to loop through an object collection
For arrayLoopIterator = LBound(validShapes) to UBound(validShapes) ' One way to loop through an array
If shapeLoopIterator.Name = validShapes(arrayLoopIterator) Then
foundShapes.Add shapeLoopIterator ' store the found shape as a reference to the shape
'Could put something in here to break out of the loop
End If
Next arrayLoopIterator
Next shapeLoopIterator
ExampleFindShapes = foundShapes
End Function
Coding from memory as I don't have Visio installed on this machine, so Page might be something else.
I have stored a reference to the shape instead of just the name, because the collection of found shapes will be easier to use in your parts 3 & 4, instead of you having to find and reference the shapes again.
The answer gets a little more complicated if you are working with grouped shapes. I suggest a new question referencing this one if this is the case as the answer will involve recursion and passing the collection down the line which a little more complex.
I need a reference to a selected (via mouse click, it only needs to be one selection) shape in Visio. However the shape might be in a group.
I cant seem to get it to work when I select a shape in a group, the shp Object remains empty.
Sub selectTest()
Dim sel As Visio.Selection
Set sel = ActiveWindow.Selection
Dim shp As Visio.Shape
Set shp = sel.PrimaryItem
If Not shp Is Nothing Then
MsgBox "It worked"
Else
MsgBox "No shape in sel"
End If
End Sub
When the "Top-Level" Group is selected, it works.
When a shape inside the group, which might as well be a group itself, is selected, it doesn't.
When a shape which is not in a group is selected, it works again.
Context: I want to fire custom VBA code from the context menu. When you right click the shape, it is selected automatically.
How can I get a reference to a shape when it is in a group?
EDIT: To clarify further: Shapes inside my Document all have corresponding database entries. I want to (via XML) add a custom Delete button to the context menu (that works), this should call a deletemethod that gets the shape on which the method was called as a parameter so it can search for the corresponding DB entry and delete that (as well as the entries of any subshapes if the selected shape is a group) before the shape (and all of its subshapes) is deleted with shape.delete
Use Selection.IterationMode property to include sub-selected shapes in the selection
Set sel = ActiveWindow.Selection
sel.IterationMode = 0
Set shp = sel.PrimaryItem
I don't know Visio VBA, but give it a try:
UPDATE
Sub selectTest()
Dim x As Integer
Dim sel As Visio.Selection
Dim shp As Visio.Shape
Dim inner_shape As Visio.Shape
Set sel = ActiveWindow.Selection
Set shp = sel.PrimaryItem
For x = 1 To shp.Shapes.Count
Set inner_shape = shp.Shapes(x)
'// Do something with inner shape
Next
End Sub