My question is generic because I've run into this multiple times for other aspects of an object.
I have a group of blocks that each contain a date (think of a calendar). I am using macros to revise the date based on the current date. However I need to have those blocks grouped so I can animate the collection together.
I believe I have a long workaround, but it involves code to ungroup, make the change, regroup, reconfigure animation, reassign the trigger, etc.
It seems the simple solution would be to directly modify the text of the grouped object if possible.
Grouped shapes can be accessed via the parent shape's GroupItems property.
Eg for a slide containing a single group consisting of several rectangles:
Sub Tester()
Dim s As Shape, e As Shape
With ActivePresentation.Slides(1)
For Each s In .Shapes
Debug.Print "--- " & s.Name & " ---"
'loop group items...
For Each e In s.GroupItems
Debug.Print e.Name
e.TextFrame.TextRange.Text = "OK"
Next e
'address a specific sub-shape
With s.GroupItems("Rectangle 4").TextFrame.TextRange
.Text = "Hi"
End With
Next s
End With
End Sub
Related
I'm trying to create a userform that will add text to the Word document based on a mixture of inputs coming from the userform. It could be checkboxes, lists, or textboxes where one writes content. As I was looking around for codes to preserve the bookmarks that I use to transfer the inputs into Word text, I came across one that allowed me to successfully preserve the bookmark for future editing. I thought I could use the same method for multiple bookmarks, but it seems not to work. With an example, now.
I have TextBox1, TextBox2 (in the userform), Bookmark1, Bookmark2 (in the Word document), and CommandButton1 to give the ok to transfer info from the userform to the Word document. I want to make TextBox1's content appear where Bookmark1 is, and TextBox2's content where Bookmark2 is. Code I tried is:
Private Sub CommandButton1_Click()
Dim BMRange01 As Range
Set BMRange01 = ActiveDocument.Bookmarks("Bookmark1").Range
BMRange01.Text = Me.TextBox1.Value
ActiveDocument.Bookmarks.Add "Bookmark1", BMRange01
Dim BMRange02 As Range
Set BMRange02 = ActiveDocument.Bookmarks("Bookmark2").Range
BMRange02.Text = Me.TextBox2.Value
ActiveDocument.Bookmarks.Add "Bookmark2", BMRange02
End Sub
When I tried with a single bookmark (from the first "Dim" to the last BMRange01) it worked just fine, and I could edit and re-use the bookmark multiple times. When I try with two of them, however, only one of them is preserved (or rather, deleted and created back again). Specifically, the second one seems to be preserved, while the first one (Bookmark1) is deleted.
Make your life a bit easier and create a separate sub to handle the work. Eg:
Private Sub CommandButton1_Click()
ReplaceBookmarkText ActiveDocument, "Boomark1", me.TextBox1.Value
ReplaceBookmarkText ActiveDocument, "Boomark2", me.TextBox2.Value
End Sub
Sub ReplaceBookMarkText(doc As Document, bmName As String, txt)
Dim rng As Range
Set rng = doc.Bookmarks(bmName).Range
rng.Text = txt
doc.Bookmarks.Add bmName, rng
End Sub
I have a chart which I have made in Excel. Copied it manually to PowerPoint. Then I have ungrouped it twice. Then I have selected the axis shapes on the left (numbers, axis alone) and made a group. Then i have taken the rectangles of the Chart representing data, and grouped them as 1) one group for positive values and 2) one group for negative values. So I have 3 group of shapes now. I thought I could loop these three groups, but in GroupItems there are all the groups mixed together with other shapes. I came with the idea, that I could simply detect Sh.ParentGroup.Id to find out how many parents is present and to separate them on three groups by the ParentGroup.Id... So first thing I did is a simple loop trying to access Sh.ParentGroup.Id. However if I add a watch, it crashes on 4th iteration and the Visual Basic and PowerPoint, where I run the code, restarted.
For Each Sh In ActiveWindow.Selection.ShapeRange.GroupItems
' GroupParentsIDs(Sh.ParentGroup.Id) = Sh.ParentGroup.Id
MsgBox ""
Next Sh
Do you have idea why it crashes? Should I detect if the ParentGroup member exists? If it is needed to check it, then how?
Any other tips how to make it possible to differentiate between the three groups of shapes?
The key is to test the type of shape. ParentGroup will fail if it isn't a group. Something like this:
Dim sh As Shape
Dim SubSh As Shape
For Each sh In ActivePresentation.Slides(1).Shapes
Debug.Print sh.Id
If sh.Type = msoGroup Then
For Each SubSh In sh.GroupItems
Debug.Print " " & SubSh.Id
Next SubSh
End If
Next sh
I want to model something similar to a (hyper-)graph in MS Visio 2016 Professional and then export the data of the shapes to csv to further work with it.
I am trying to make a VBA Script that goes through all the shapes on the sheet and writes the (manually inserted) data from the shapes to one csv file (and in the future maybe different csv files depending on the type of the shape).
To get a feeling for VBA I tried to start with a script that counts all the shapes on the sheet but I already failed on that. Please consider this is my first time working with VBA:
Sub countShapes()
Dim shp As Shape
Dim count As Integer
count = 0
Debug.Print count
For Each shp In ActiveSheet.Shapes
count = count + 1
Debug.Print count
Next
End Sub
This returns runtime error 424, object not found.
What am I missing?
As a second step, I want the script to check that shapes that have for example the same number in the data field "id" are identical in all other data fields as well and show an error if not (before exporting to the csv files). Can I realize this using vba in visio?
Thanks a lot for any help!
ActiveSheet is an Excel property. I think you're looking for ActivePage, which is a Visio equivilent. So to fix your code above you could use this:
For Each shp In ActivePage.Shapes
count = count + 1
Debug.Print count
Next
However, if you're simply after the shape count for a page then you could write this instead:
Debug.Print ActivePage.Shapes.Count
Can I recommend some links that might also help:
http://visualsignals.typepad.co.uk/vislog/2007/10/just-for-starte.html
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
vba programming for visio
As an alternative approach you might also be interested in Visio's built-in reporting tool:
Create a report of shape data (support docs)
Getting Started with Visio 16 - Build and Apply Reports from Share Data (Video)
Re the second part of your question (check data fields) I'm assuming you're talking about reading Shape Data. If that's the case you first want to check if a row named "ID" exists and, if it does, read that value. So something like this might get you going:
Public Sub TestGetCellValues()
GetShapesCellValues ActivePage, "Prop.ID"
End Sub
Public Sub GetShapesCellValues(targetPage As Visio.Page, targetCellName As String)
Dim shp As Visio.Shape
If Not targetPage Is Nothing Then
For Each shp In targetPage.Shapes
If shp.CellExistsU(targetCellName, 0) = True Then
Debug.Print shp.NameID & "!" _
& targetCellName & " = " _
& shp.CellsU(targetCellName).ResultIU
End If
Next shp
End If
End Sub
...which might output something like this (given the associated shapes):
Sheet.2!Prop.ID = 3
I have a form with listbox which dynamically provides a list of the worksheets in the current workbook (code below). I wish to take the selected Sheet and refer to it in a formula later in the process. From hours of playing around I cannot seem to accomplish this. I believe I read somewhere that you cannot take the string back to the sub and use it to refer to to an object. So I thought maybe I can create two listboxes
for sheet name
for sheet index
that I could pass the index number to and maybe use that in my formula to lookup items from the correct sheet.
For the life of my I cannot seem to find a way to connect the two since the items will always be changing; the code will be ran on multiple workbooks by multiple operators so the layout will most likely change between users. I can easily add the second list box with index #'s but I have a block on how to associate the name which will have meaning to the user and the index which I can pass back to the sub. I realize the "On click" procedure for the list box to associate the two but with the dynamic nature of the fields I cannot come up with the logic to put that into code.
For N = 1 To ActiveWorkbook.Sheets.Count
With ListBox1
.AddItem ActiveWorkbook.Sheets(N).Name
End With
Next N
Try this out.
Declare a public variable above the code for the UserForm, making it available throughout your workbook from any module or code.
Public listChoice As String
Using your code to get the sheet names for the ListBox rowsource.
Private Sub UserForm_Activate()
For n = 1 To ActiveWorkbook.Sheets.count
With ListBox1
.AddItem ActiveWorkbook.Sheets(n).name
End With
Next n
End Sub
Including an update event for the ListBox
Private Sub ListBox1_AfterUpdate()
listChoice = ListBox1.Text
End Sub
I included a test just to demonstrate that the result is still retained. You don't need this, it demonstrates the results on the screenshot.
Private Sub cmdTestChoice_Click()
MsgBox ("The choice made on the ListBox was: " & listChoice)
End Sub
edit: To access that sheet later, you can call it using something like this:
Some examples of different ways to access a cell, using .Range, or .Cells, with numbers or letters.
Using lRow & lCol as Long to set row and column numbers.
Sheets(listChoice).Cells(lRow, lCol).Value = TextBox1.Value 'Set cell on sheet from TextBox
TextBox2.Value = Sheets(listChoice).Range("A2").Value 'Set TextBox From Cell on Sheet
'Set a cell on another sheet using the selected sheet as a source.
Sheets("AnotherSheet").Cells(lRow, "D") = Sheets(listChoice).Range("D2")
I want to count different types of shapes in my diagram, and I can't seem to get that done. I think I have to code something for that.
I use Visio 2007 for that.
I have a flow chart with mostly process shapes that I want to distinguish by name. E.g "Type A", "Type B". And at the end, I want to have a list that tells me how often I used Type A and Type B. Counting by hand will be to error prone.
I already checked out the report/statistic function (I'm using it in German, so I'm afraid I can't tell you the exact menu name), where you can define a report function by yourself, although that one misses features for my needs. I managed to make a report for my shapes, but only when they all are selected. But when the user has to select them by hand, then he can count them as well right from the start... And you have to make 4-5 clicks in order to get that static report result.
Another almost useful function I found was the layer method: Create a layer for the types I want to count, and then assign the shapes to that layer. But, again, this is too error prone. If the user misses a shape, the count will be wrong.
So I think I will need to code something with the VBA.
Additionally, I'd like to have a text field next to my diagram where the resulting counts for all types are always displayed. So that you see when you add a shape of Type A that the count goes up by one.
Could anyone help me on this?
try:
Option Explicit
Dim myShape As Shape
Sub ShapesDetails()
Call DeleteShapes(True)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 139.5, 81.75, 72, 72).Select
Selection.Name = "Rectangle"
ActiveSheet.Shapes.AddShape(msoShapeSmileyFace, 252.75, 71.25, 72, 72).Select
Selection.Name = "Smiley Face"
Application.CutCopyMode = False
Call ShapeDetails(True)
End Sub
Sub ShapeDetails(x As Boolean)
For Each myShape In ActiveSheet.Shapes
MsgBox "Shape name: " & myShape.Name & vbTab & " Shape type: " & myShape.Type
Next
End Sub
Sub DeleteShapes(x As Boolean)
For Each myShape In ActiveSheet.Shapes
myShape.Delete
Next
End Sub
Use Data= reports = advanced to configure a report to count objects with your custom shape Property (e.g. 'MIO') && exists. (Or another field, many to choose from). I set all the boxes i wanted to count to have property 'MIO'=TRUE, and then chose to display property Displayed Text. It takes some fiddling around in the Subtotals dialog and options in the next window to get the count looking nice. Leave COUNT unticked, and in the options dialog enable 'show all values' and tick 'exclude duplicate rows from group'.
Outputs as XML Excel Viso object. I know for the visio object, to update report, right click on it =Run report.
HTH