I need to have the name of a visio shape change to a user entered value when the shape is dropped to the page. I have created two shape data fields: Name and State. The name field prompts the user for the name when the shape is dropped and this is the value I would like to have transferred to the actual shape name. The reason for this is so that the shape data field "state" can be changed programmatically using the value assigned to the "Name' field as shown in the code below:
Sub SetStatePassive()
Dim vPag As Visio.Page
Set vPag = Visio.ActivePage
Dim shp As Visio.shape
Set shp = Visio.ActivePage.Shapes("XV 013A")
Dim vCell As Visio.cell
Set vCell = shp.Cells("Prop.State")
vCell.FormulaU = Chr(34) & "Passive" & Chr(34)
End Sub
I have not found a way to change the actual shape name to match the "Name" shape data field automatically.
Is there a way to do this with a shapesheet formula or have the shape trigger some VBA code after the shape data has been defined. Using code to change the name is not a problem, but how can the code be triggered automatically to set the shape name to the shape data field "Name"
Or is their way to get the shape to prompt the user, on drop, to change the shape name directly.
shp.Name = textString
Watch out for duplicate names though.
Related
I'm trying to create a way for a word document to have certain textfields data to be replaced with other data. In my case, textfields are shown as a part of shapes and the textfields themselves don't have name's to them so I wanted to possibly do it by their shape ID. So for example I have a 5 Textboxes next to each other and say I want to edit the 4th textbox to say something since it's blank without affecting the other textboxes. What would I need to do?
Though Process: Because all the files have the same format, if I can figure out the id of that shape or textbox, I can directly reference that id and change the textfield that way. The text in the field is all random so I can't do a specific find word and replace so that's why I'm trying to do it by id or even just by having it do a count of the number of shapes on the page of a word document.
Tip: I turned on paragraph markers to see the textboxes more clearly.
Example of Code I've written so far:
Sub TextBox()
'find a specific textbox and edit it
Dim doc As word.Document, rng As word.Range
Dim shp As Shape, iShp As word.InlineShape
Set doc = ActiveDocument
Dim textbCount As String
Dim textbId As String
'textbCount = ActiveDocument.Shapes.Count
'textbId = oShape.ID
Dim sr As ShapeRange
Set sr = shp.TextFrame.TextRange.ShapeRange(5)
For Each shp In sr
If shp.ID = 0 Then
'oShape.TextFrame.TextRange.InsertAfter shp.ID
'shp.Delete
Debug.Print shp.Type
Debug.Print shp.ID
End If
Next shp
If ActiveDocument.Shapes.Count > 0 Then
For Each shp In ActiveDocument.Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If shp.TextFrame.HasText = True Then
'shp.TextFrame.TextRange.GoToNext (wdGoToField)
'shp.Delete
'shp.Delete
shp.TextFrame.TextRange.InsertAfter textbCount
Exit For
End If
End If
Next shp
End If
End Sub
This is code you could use, I was able to just figure out the answer. What the code does is checks that the word document that you are trying to read is open and then it first checks to see if there are any shapes at all on the document which is the c > 0 because textboxes are categorized as shapes. Then it does a For Each loop going through all the shapes on the entire document and each shape has it's own unique identifier.
I already tested this for if templates that have the same format of textboxes, they will typically share the same identifier, so if you say have 2 word documents with each 20 textboxes and its a carbon copy of the other just with different text in the boxes almost like they took this blank document and then used it as the base template, it's highly likely that the ID's between the 2 documents are the same if opened separately, if they are combined into 1 document is when the ID's will change so that your not referencing the same data.
To continue on with the code, it will next check all the textboxes for a #, this can be changed out for anything, but for my case I wanted to find out which boxes by their ID I would be using since the word doc won't tell you, so because no where else on the document had #'s, I used those to find where the boxes were. Once you know the ID, you can just reference the boxes directly instead of using the #'s but you need to first know which ones have them.
Next the code will print to the "Immediate Window" which is like a debug window that you can open either in the view tab or by ctrl + G if your one windows and what it will print is the shape ID for each shape that has the # and then print whatever text is in that box which should include the # there along with whatever text is there in that box.
Now if you want to add text to the text box, I didn't include it in my example, or even replace the text. Just make an if statement for if shp.ID = 16 for example then inside that If Then statement say shp.TextFrame.TextRange.Text = "" or if you have a string you want to pass in, replace "" with whatever string that is and in the double quotes you can either leave that blank to make that textbox your referencing blank or you can put text in it to make it say something.
If your doing a project, like I was, and it requires checking a lot of these textboxes to reference the string to another textbox so basically one textbox determines the other. Use For Each shp In oShp a lot or your equivalent to that and check each ID and store it in a string variable and then do a separate For Each to reference those string variables to make new if statements or declarations since you you'll need to go through all the textboxes at least once to grab whatever data might be contained in them since it goes through the For Each sequence one at a time.
Dim shp As Shape
Dim oShp As Object
Dim doc As Document
Dim c As Integer
Dim objWord As Object
Dim objDoc As Document
'Set doc = ActiveDocument
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\word.docx") 'Set this to wherever the word file is located along with the name of the word file so "C:\Users\worddoc.docx" is an example you could do
'Set objDoc = objWord.ActiveDocument
Set doc = objWord.ActiveDocument
Set oShp = doc.Shapes
c = ActiveDocument.Shapes.Count
'Set text1 = shp.TextFrame.TextRange
If c > 0 Then
For Each shp In oShp
If InStr(shp.TextFrame.TextRange.Text, "#") Then
Debug.Print shp.ID
Debug.Print shp.TextFrame.TextRange.Text
End If
Next shp
Debug.Print c
End If
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
I have the following code:
Sub CommandButton1_Click()
Dim NoIO As String
Dim shp1 As Visio.Shape
Dim i As Integer
Set shp1 = Application.ActivePage.Shapes(1)
NoIO = ComboBox1.Value
If NoIO = "7" Then
MsgBox shp1.id
'Target shape id selected'
'Change shape data of that shape'
End If
Unload Me
End Sub
Whenever a shape is dropped onto the screen, a user form is presented to the user. When it is submitted, this code runs.
Currently, I can only output the ID of the shape first dragged onto the screen shown by this line:
Set shp1 = Application.ActivePage.Shapes(1)
How can I change this so that the ID of the shape dragged onto the screen is shown instead?
Thank you
If you are using EventDrop handler and a ShapeSheet cell, you can just pass shape ID to your function. You could use something like the formula below (where ID() is a built-in function returning shape ID. You can use it to get the shape from the OnDrop handler defined in your VBA code. "&" is used to concatenate text strings in VBA:
RUNMACRO("ThisDocument.OnDrop("& ID() &")")
And then in VBA:
Sub OnDrop(shapeId)
Debug.Print shapeId
Set shape = ActiveDocument.Shapes.ItemFromID(shapeId)
' do something with the shape
End Sub
Better, you can use CALLTHIS instead of RUNMACRO (it always passes subject shape as a first parameter)
CALLTHIS("ThisDocument.OnDrop")
And then in VBA:
Sub OnDrop(x As Shape)
Debug.Print shape.ID
' do something with the shape
End Sub
In the event handler, before you show the form, you need to remember the shape, and then you can pass it to the form.
Please note that I assume in the above examples that "OnDrop" is defined in "ThisDocument". If it's defined in a module, you don't need "ThisDocument." prefix
Yet another option could be to handle the "Shape Added" event in the VBA instead of specifying the ShapeSheet formula. Your event handler receives shape being dropped as a parameter in this case.
I'm in the process of automating the production of a PowerPoint report from and Excel spreadsheet. I've got the process working up until I paste a table.
I'm pasting the table to PowerPoint using PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting") and the table appears as a shape on my slide (the third shape).
To refer to the new shape I was using Set pShape = Slide2.Shapes(Slide2.Shapes.Count) but now now when I paste, the pShape is assigned "Shape 2" (not "Shape 3"). Is there something that needs to be done between the pasting and the assignment of the object?
Code below, commented where the issue occurs. (Full code removed; viewable here)
'Copy tables from Excel
Set rng = ws.Range("A:A")
rng.ColumnWidth = 22.75
Set rng = ws.Range("A4:C27")
'Copy the table range
Application.CutCopyMode = False
rng.Copy
Application.Wait (Now + TimeValue("0:00:02"))
'The issue occurs here!!! '-------------------------------------
'Paste the table in to the slide
Slide2.Select
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
'Name the new shape object
Set pShape = Slide2.Shapes(Slide2.Shapes.Count)
pShape.Name = "Slide_2_Table_1"
pShape.LockAspectRatio = False
'Shapes.Count' ≠ Shape Index# !
The .Count is not the same as the upper limit of current shape .Index numbers.
The numbering system is easier understood by listing all the shapes within the document:
Sub ListShapes()
'hit CTRL+G to view output in Immediate Window
Dim sh As Shape, sld As Slide, idx As Long
Set sld = ActivePresentation.Slides(1) '<-- change to your slide number
For Each sh In sld.Shapes
idx = idx + 1
Debug.Print "Shape ID#" & sh.Id, "Index #" & idx, "Name: " & sh.Name
Next sh
Debug.Print "Count of shapes: " & sld.Shapes.Count
End Sub
NOTE: There is alternative code for Excel at the bottom of this post!
To demonstrate, we can add shapes to a new document:
First, add one rectangle manually by clicking Insert (on the ribbon)
[If using Excel, click Illustrations], then Shapes, and the rectangle symbol.
Draw the shape, then hit Ctrl+C to copy it, and hit Ctrl+C four times to paste 4 copies.
Run the above procedure, and the output will be:
Shape ID#2 Index #1 Name: Rectangle 1
Shape ID#3 Index #2 Name: Rectangle 2
Shape ID#4 Index #3 Name: Rectangle 3
Shape ID#5 Index #4 Name: Rectangle 4
Shape ID#6 Index #5 Name: Rectangle 5
Count of shapes: 5
Note that the Index is not a property of this object, but it counted in order that Excel's storing the shapes in memory (same as the order returned by the For Each..Next statement.
You can prove this by running:
Debug.Print ActivePresentation.Slides(1).Shapes(5).Name
...which in this case return Rectangle 5.
Another way to understand how Excel is storing the shapes is with the Watch Window. Add a breakline or Stop in the middle of the loop, then highlight ws.Shapes, right-click it, choose Add Watch... and click OK. Browse through the tree to discover the varies properties/attributes of the shapes within the document.
Next, if we delete the "middle rectangle" and run the above procedure again, we will get:
Shape ID#2 Index #1 Name: Rectangle 1
Shape ID#3 Index #2 Name: Rectangle 2
Shape ID#5 Index #3 Name: Rectangle 4
Shape ID#6 Index #4 Name: Rectangle 5
Count of shapes: 4
The ID and Name of remaining shapes do not change, but the Index is renumbered to reflect the new "order".
...thus to return the name Rectangle 5 we now need to use:
Debug.Print ActivePresentation.Slides(1).Shapes(4).Name
Referring to shapes (including controls)
When you refer to a shape by number, like .Shapes(𝔁), you're referring to the shape Index Number 𝔁, not the ID number. Index numbers are dynamically assigned as needed as therefore are not a stable method to refer to a shape.
Therefore, .Count is irrelevant to the shape Index number.
Ideally, you should refer to the shape by the .Name or .ID number. If generating shapes dynamically, you'd ideally store a list of shapes in an array or collection, so you can look at the list as required.
Retrieve "Last Shape Created"
If the only reason for using the Index Number is to retrieve the "last shape created", then you could use a function like this to get the index number:
Function idxLastShape(slideNum As Long) As Long
Dim sh As Shape
For Each sh In ActivePresentation.Slides(slideNum).Shapes
idxLastShape = idxLastShape + 1
Next sh
End Function
Example Usage:
Debug.Print idxLastShape(1) 'Returns index of last shape on slide#1
NOTE: There is alternate code for Excel at the bottom of this post!
Alternatively, you could have the function return a reference to the actual shape object, rather than the number, like this:
Function LastShape(slideNum As Long) As Shape
Dim sh As Shape
For Each sh In ActivePresentation.Slides(slideNum).Shapes
Set LastShape = sh
Next sh
End Function
...so you could get the name of the "last shape" with:
Debug.Print LastShape(1).Name
Delete the most recently created shape
Using the function above, you can use any methods you would normally use with shapes. For example, you can delete the "last shape" that was created on Slide #1:
LastShape(1).Delete
CAUTION!
The examples in the post (including the deletion example!) are indiscriminate of what type of shape they're returning/editing/deleting!
There are dozens of types of shapes, from graphics to sound/video and controls. You can filter the shapes being enumerated by these procedures using the .Type property of the Shape object, as well as other methods. There is a partial list here, and more information in the links below.
Alternative code for Excel:
List all shapes on worksheet (Excel)
Sub ListShapes()
'hit CTRL+G to view output in Immediate Window
Dim sh As Shape, ws As Worksheet, idx As Long
Set ws = Sheets("Sheet1") '<-- change to your worksheet name
For Each sh In ws.Shapes
idx = idx + 1
Debug.Print "Shape ID#" & sh.ID, "Index #" & idx, "Name: " & sh.Name
Next sh
Debug.Print "Count of shapes: " & Sheets("Sheet1").Shapes.Count
End Sub
Return index number of "last shape" (Excel)
Function idxLastShape(shtName As String) As Long
Dim sh As Shape
For Each sh In Sheets(shtName).Shapes
idxLastShape = idxLastShape + 1
Next sh
End Function
Example Usage: Debug.Print idxLastShape("Sheet1")
Return reference to "last shape" object (Excel)
Function LastShape(shtName As String) As Shape
Dim sh As Shape
For Each sh In Sheets(shtName).Shapes
Set LastShape = sh
Next sh
End Function
Example Usage: Debug.Print LastShape("Sheet1").Name
More Information:
MSDN : Shapes Object (PowerPoint/VBA)
MSDN : Shapes Object (Excel/VBA)
MSDN : MsoShapeType Enumeration (Office)
Stack Overflow : Overview of working with Form Controls and ActiveX Controls
MSDN : Working with Shapes (Drawing Objects)
Office.com : How to add Shapes
BreezeTree : Programming Shapes (AutoShapes) with VBA
WiseOwl : Working with Shapes (Tutorial)
Other ways to copy from Excel to Powerpoint:
SpreadsheetGuru : Copy & Paste An Excel Range Into PowerPoint With VBA
ExcelOffTheGrid : Controlling Powerpoint from Excel using VBA
mvps.org : Paste Excel chart as pictures in PowerPoint (Paste Special)
I'm trying to create a macro to change the thickness of connectors that are connected to a specific block. This is what I have so far:
Private Sub HighlightPaths_Click()
Dim selection As Shape
Dim connections() As Long
Dim i As Integer
'Msgbox glued shapes
If ActiveWindow.selection.Count = 0 Then
MsgBox ("Select a shape then click this button.")
Else
'Set shape to current selection
Set selection = ActiveWindow.selection(1)
'Get array of connectors on selected object
connections() = selection.GluedShapes(visGluedShapesAll1D, "")
'Resize connectors to that shape [ERROR HERE]
For i = 0 To UBound(connections())
connections(i).Cells("LineWeight").Formula = "0.5 pt"
Next
End If
End Sub
I know this comes from the fact that I'm trying to access the Cells property in a type that is not applicable. Do I have to search for the returns of the Glue method in the list of master shapes to find the dynamic connector master shapes?
Array connections(), contains connected shapes IDs.
You need get shape object, before change it Line Weight.
ActivePage.Shapes(connections(i)).Cells("LineWeight").Formula = "0.5 pt"