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.
Related
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.
I have a PowerPoint document where users can input text into several TextBoxes, over 6 slides in total.
On the last slide, I want to check if the user has filled in every TextBox in the presentation.
I tried using lots of code snippets on the internet and modifying them, however I am a complete VBA noob and, surprisingly, it did not work out. :')
I would greatly appreciate your help with this task.
It would be even better if it is possible to check whether the user has input AT LEAST 4 characters in each textbox. However I have no idea how to start programming this...
Here is my code, it does not show errors however nothing happens when clicking the CheckBox at the end.
Public Sub CheckTextBox()
Dim fTextBox As Object
For Each Slide In ActivePresentation.Slides
For Each fTextBox In ActivePresentation.Slides
If TypeName(fTextBox) = "TextBox" Then
If fTextBox.Text = "" Then
MsgBox "Please make sure to fill out all fields!"
End If
End If
Next
Next
End Sub
'When ticking this CheckBox, the MsgBox should show up
Private Sub CheckBox1_Click()
CheckTextBox
End Sub
Thank you guys so much for your help.
Your inner For-loop is wrong, you need to loop over all Shapes of the slide, instead, you start another loop over all slides.
Basically, all objects that you place on a slide are Shapes. If you use TypeName, you will get Shape. To distinguish the single shape-types, use the property type of the shape-object. A list of types can be found at https://learn.microsoft.com/de-de/office/vba/api/office.msoshapetype - a textbox has a type msoTextBox (17).
To get the text of a shape, use the property TextFrame.TextRange.Text of the shape.
Try the following code (it checks already for a length of at least 4 characters). It will stop at the first textbox that has less than 4 chars in it (else, you would get one MsgBox for every textbox) and select it.
Public Sub CheckTextBox()
Dim sh As Shape, slide As slide
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Debug.Print TypeName(sh)
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < 4 Then
MsgBox "Please make sure to fill out all fields!"
slide.Select
sh.Select
Exit For
End If
End If
Next
Next
End Sub
UPDATE
The code above didn't take into account the shapes within groups. The following code loops over all shapes of all slides and calls the function checkShape that will check
a) If the shape is a textBox (msoTextBox, 17) - if yes, the length of the text is checked and if too short, that shape is returned.
b) If the shape is a group (msoGroup, 6), it calls (recursively) the function for all child shapes and returns the first child textbox found.
The main routine (CheckAllTextBoxes) checks if any textBox was found, and, if yes, will select it and issue the message.
Public Sub CheckAllTextBoxes()
Dim slide As slide, sh As Shape
For Each slide In ActivePresentation.Slides
For Each sh In slide.Shapes
Dim textBox As Shape
Set textBox = CheckShape(sh, 4)
If Not textBox Is Nothing Then
slide.Select
textBox.Select
MsgBox "Please make sure to fill out all fields!"
Exit Sub
End If
Next
Next
End Sub
Function CheckShape(sh As Shape, minLen As Integer) As Shape
' Check if shape is a Textbox and then text is not long enough
If sh.Type = msoTextBox Then
If Len(sh.TextFrame.TextRange.Text) < minLen Then
Set CheckShape = sh
Exit Function
End If
End If
' For a group, check all it's child shapes
If sh.Type = msoGroup Then
Dim child As Shape
For Each child In sh.GroupItems
Dim textBox As Shape
Set textBox = CheckShape(child, minLen)
If Not textBox Is Nothing Then
' Found a Textbox within the group, return it
Set CheckShape = textBox
Exit Function
End If
Next child
End If
End Function
For those looking for c# code to list all text boxes in a presentation:
using Microsoft.Office.Interop.PowerPoint;
using MsoShapeType = Microsoft.Office.Core.MsoShapeType;
public static IEnumerable<Shape> AllTextBoxes (Presentation presentation) =>
from slide in presentation.Slides.Cast<Slide>()
from shape in slide.Shapes.Cast<Shape>()
from textBox in AllTextBoxes(shape)
select textBox;
public static IEnumerable<Shape> AllTextBoxes (Shape sh)
{
IEnumerable<Shape> _() { if (sh.Type == MsoShapeType.msoTextBox) yield return sh; }
return sh.Type == MsoShapeType.msoGroup ? sh.GroupItems.Cast<Shape>().SelectMany(AllTextBoxes) : _();
}
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 below code that I'm trying to ONLY delete a single picture, however it's deleting all my items on the sheet (Checkboxes, TextBoxes, Buttons etc.).
I should also mention there are two images on the sheet, however I want it to only delete the second picture.
Private Sub DeletePictures()
Dim shape As Excel.shape
For Each shape In ActiveSheet.Shapes
shape.Delete
Next
End Sub
You'll need to find the name of your shape.
In Excel 2010:
Select your picture and click the "Format" ribbon.
In the "Arrange" section click the "Selection Pane" icon. The names of all the shapes on the sheet should appear on the right of the sheet with your selection highlighted.
Next update your code to only work on the named shape:
Private Sub DeletePictures()
Dim shape As Excel.shape
For Each shape In ActiveSheet.Shapes
If shape.Name = "Picture 1" Then
shape.Delete
End If
Next
End Sub
If you want to delete all pictures you can check the shape type:
If shape.Type = 13 Then or If shape.Type = msoPicture Then
A full list of shape types:
https://msdn.microsoft.com/en-us/library/aa432678(v=office.12).aspx
Edit:
Had a moment there.... obviously once you know the name of the shape there's no need to loop through all the shapes on the sheet (Thanks #CallumDA for pointing the obvious out in your comment). :)
ActiveSheet.Shapes("Picture 1").Delete - is all the code you need.
I have added a rectangle shape to a spreadsheet. I now wish to use a macro on event RectangleA_Click(). I know the shape's name is RectangleA as I have the below sub:
Sub f()
Dim Shape As Shape
For Each Shape In ActiveSheet.Shapes
Debug.Print Shape.Name
Next
End Sub
I have written the code:
Private Sub RectangleA_Click()
MsgBox "hello"
End Sub
In the relevant sheet object space in the editor. On clicking the shape the subroutine is not called.
I am aware that I can assign this using right click> assign macro, but would prefer to avoid this as it seems like an unnecessary step. I'm also aware that there are Active X controls which automatically assign the macro, again I would prefer to avoid this if possible.
Something like this may work:
Sub AssignMacroToShape()
Set shpTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1680#, 594#, 120#, 74.25)
shpTemp.OnAction = ActiveWorkbook.Name & "!Macro Name"
End Sub
But it will be much easier just to right click > Assign Macro.
This above code is useful if you need to create the shape then assign a macro to it after creation.
You can look into the OnAction event to get the answer to specifics if this doesn't help.