I just want to connect 2 squares after selecting them.
My code below doesn't work, can't see how to fix it:
Sub ConnectSelectedShapes()
Dim shpFirst As Shape
Dim shpSecond As Shape
Dim shpShapes As Shapes
Set shapesRange = ActiveWindow.Selection.ShapeRange
Set shpFirst = shapesRange(1)
Set shpSecond = shapesRange(2)
With shpShapes.AddConnector(Type:=msoConnectorCurve, BeginX:=0, _
BeginY:=0, EndX:=100, EndY:=100).ConnectorFormat
.BeginConnect ConnectedShape:=shpFirst, ConnectionSite:=1
.EndConnect ConnectedShape:=shpSecond, ConnectionSite:=1
.Parent.RerouteConnections
End With
End Sub
You've delcared shpShapes, however you haven't defined it...
Set shpShapes = ActiveWindow.View.Slide.Shapes
And, of course, you'll need to make sure that 2 shapes have been selected before running the code.
Hope this helps!
Related
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)
After selecting a shape (f.e. square or more squares) all the connectors glued to this shape would highlight red, yellow whatever.
The found code below is not working for me, any advice? (I am not coder, so please have patience with me)
Set shpAtEnd = cnx(1).ToSheet
' use HitTest to determine whether Begin end of connector
' is outside shpAtEnd
x = shpAtEnd.HitTest(shpTaskLink.Cells("BeginX"), _
shpTaskLink.Cells("BeginY"), 0.01)
If x = visHitOutside Then
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 2
Else
' do other stuff
End If
This is my first answer on stackoverflow and I hope the following VBA code can solve your problem on how to highlight connectors or connected shapes in Visio!
Public Sub HighlightConnectedShapes()
Dim vsoShape As Visio.Shape
Dim connectedShapeIDs() As Long
Dim connectorIDs() As Long
Dim intCount As Integer
' Highlight the selected shape
Set vsoShape = ActiveWindow.Selection(1)
vsoShape.CellsU("Fillforegnd").FormulaU = "RGB(146, 212, 0)"
vsoShape.Cells("LineColor").FormulaU = "RGB(168,0,0)"
vsoShape.Cells("LineWeight").Formula = "2.5 pt"
' Highlight connectors from/to the selected shape
connectorIDs = vsoShape.GluedShapes _
(visGluedShapesAll1D, "")
For intCount = 0 To UBound(connectorIDs)
ActivePage.Shapes.ItemFromID(connectorIDs(intCount)).Cells("LineColor").FormulaU = "RGB(168,0,0)"
ActivePage.Shapes.ItemFromID(connectorIDs(intCount)).Cells("LineWeight").Formula = "2.5 pt"
Next
' Highlight shapes that are connected to the selected shape
connectedShapeIDs = vsoShape.connectedShapes(visConnectedShapesAllNodes, "")
For intCount = 0 To UBound(connectedShapeIDs)
ActivePage.Shapes.ItemFromID(connectedShapeIDs(intCount)).Cells("LineColor").FormulaU = "RGB(168,0,0)"
ActivePage.Shapes.ItemFromID(connectedShapeIDs(intCount)).Cells("LineWeight").Formula = "2.5 pt"
Next
End Sub
To run the macro, you can consider associating with double-click behavior of shapes.
If you only need to highlight incoming/outgoing connectors and incoming/outgoing shapes, replace visGluedShapesAll1D with visGluedShapesIncoming1D/visGluedShapesOutgoing1D and visConnectedShapesAllNodes with visConnectedShapesIncomingNodes/visConnectedShapesOutgoingNodes.
Learn more at visgluedshapesflags and visconnectedshapesflags. Good luck!
The following code will loop though all 1d-Shapes glued to the first shape in your Selection and write their name to the Immediate window. This should be a good starting point.
Visio has no Event that fires if a Shape is selected (at least not without some workarounds), so maybe bind the macro to a keybind.
The visGluedShapesAll1D flag can be replace with another filter as described here: Microsoft Office Reference
Sub colorConnectors()
If ActiveWindow.Selection(1) Is Nothing Then Exit Sub
Dim selectedShape As Shape
Set selectedShape = ActiveWindow.Selection(1)
Dim pg As Page
Set pg = ActivePage
Dim gluedConnectorID As Variant 'variant is needed because of "For Each" Loop
For Each gluedConnectorID In selectedShape.GluedShapes(visGluedShapesAll1D, "")
Debug.Print pg.Shapes.ItemFromID(gluedConnectorID).NameU
Next gluedConnectorID
End Sub
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
So I have a sheet with some pictures. All of these are just a copy paste of the original picture so they all have the same name "Flower".
I want to select all of them and flip them. But it will only select the original, how do I get past this? I tried incorporating a loop as well, without luck.
Sub Test()
ActiveSheet.Shapes.Range(Array("Flower")).Select
Selection.ShapeRange.Flip msoFlipHorizontal
End Sub
I know that I could simply rename them to Flower1, Flower2 etc. but the plan is to use this for a lot of pictures, so it would take to long to change manually. If it could all be done with a loop, that would be fine, but then I would still have the same problem as above.
You can loop thru the collection Shapes looking for the shapes with the given name. Try this.
Sub Test()
Dim Pic As Shape
For Each Pic In ActiveSheet.Shapes
If Pic.Name = "Flower" Then Pic.Flip msoFlipHorizontal
Next Pic
End Sub
In addition, you can code this without selecting it. Faster and more reliable.
There are two objects in VBA that could be useful - the shape collection named Shapes and the Shape itself. Thus, you can loop through the collection like this:
Sub Test()
Dim shShape As Shape
Dim shCollection As Shapes
Set shCollection = ActiveSheet.Shapes
For Each shShape In shCollection
shShape.Flip msoFlipHorizontal
Next shShape
End Sub