I'm pretty rusty with VBA and I was hoping someone could point me in the right direction, or help me out. What I'm trying to do is run a macro that will cycle through each active container on my sheet, and then count the number of shapes within that container. Then I'd like to update a field in the shape data for the container with the number of shapes.
This is what I have so far:
Public Sub countContainers()
Dim vsoPage As Visio.Page
Dim vsoDocument As Visio.Document
Dim vsoDocuments As Visio.Documents
Dim vsoPages As Visio.Pages
Dim vsoContainerShape As Visio.Shape
Dim containerId As Variant
For Each containerId In vsoPage.GetContainers(visContainerIncludeNested)
Set vsoContainerShape = vsoPage.Shapes.ItemFromID(containerId)
Debug.Print vsoContainerShape.NameU
Next
End Sub
The error I get is Object Variable or With Block variable not set
Any ideas?
The error is because you have declared the vsoPage but you never assigned it to any page in your document.
Add a line such as this to initialize it and the error goes away:
Set vsoPage = ActivePage
Related
I have this task where i need to find some type of hybridshapes and collect them in a listbox
i have done that part, but i need to create it in such a way that when user selects a item from the list box respective hybridshape or object should get selected in catia
here is the image
here is the code
Option Explicit
Dim ODoc As Document
Dim opartdoc As PartDocument
Dim oPart As Part
Dim ohybs As HybridBodies
Dim ohyb As HybridBody
Dim ohybshps As HybridShapes
Dim ohybshp As HybridShape
Dim i As Integer
Dim j As Integer
Private Sub UserForm_Initialize()
Set ODoc = CATIA.ActiveDocument
Set opartdoc = CATIA.ActiveDocument
Set oPart = opartdoc.Part
End Sub
Private Sub ListBtn_Click()
Set ohybs = oPart.HybridBodies
Set ohyb = ohybs.Item("Shapes")
Set ohybshps = ohyb.HybridShapes
For i = 1 To ohybshps.Count
Set ohybshp = ohybshps.Item(i)
ShapeBox.AddItem ohybshp.Name
ShapeBox.Font.Bold = True
ShapeBox.Font.Size = 25
Next
End Sub
Private Sub SelectBtn_Click()
End Sub
i dont know much about listbox handling
how do i create link between items in listbox and objects in catia
thanks
Hi you could add this to your code and try it. Beware your solution is pretty fragile one. You should consider more robust checks for objects validation
The trick lies in ShapeBox.Value in Shapebox click event. The rest is just catia stuff. But this solution is not foolproof because if you have more shapes with same names it might not select the right one. I would prefer creating a collection where you store real object from sets and the passing these objects to selection
Private Sub ShapeBox_Click()
Call opartdoc.Selection.Clear
Call opartdoc.Selection.Add(opartdoc.Part.FindObjectByName(ShapeBox.Value))
End Sub
I can't seem to figure out how to drop a shape using VBA.
What I want to do is: The user opens a UserForm and enters something in the TextBoxes. When clicking on the commandbutton I want to load a Shape (i.e. ressource) from a custom stencil (i.e. shapes.vssx) write the User-Entries into the ShapeData (i.e. write a Name string in Props.Name) and then Drop it somewhere on the sheet. I know I have to use the Shape.Drop method but how do I reference the specific Master-Shape I want to use for creating the new shape?
So far I am trying with this
Private Sub CommandButton1_Click()
Dim shp As Visio.Shape
Dim page As Visio.page
Set page = Application.ActiveWindow.page
Set shp = Application.Documents.Item("shapes.vssx").Masters.ItemU("ressource")
page.Drop shp, 1, 1
End Sub
Which returns a type mismatch. What am I missing?
You're looking to drop a Master rather than a Shape so try this modification of your code (untested):
Private Sub CommandButton1_Click()
Dim mst as Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.page
Set pag = Application.ActiveWindow.Page
Set mst = Application.Documents.Item("shapes.vssx").Masters.ItemU("ressource")
'You might also want to add some checks that the target document and then master exist
Set shp = pag.Drop(mst, 1, 1)
End Sub
I've been reading numerous posts here in the forum regarding my problem but I'm afraid I'm still doing something awfully wrong.
Overtaken today by the button rage, I admit to some confusion.
I have been trying to put a simple userform combobox (frmWorkers) which includes a combobox (cbWorkers) and linked to a defined rowSource (Workers), the click of which will simply get me the value of that worker's name. (Thank you Ann!)
The combobox opens just fine but refuses to click and there I'm stopped.
I'm now receiving a 'compile error, for each control variable must be variant or object' at **for each WorkerName...
Private Sub UserForm_Initialize()
Dim wsControl As Worksheet
Dim Workers As Range
Dim WorkerName As String
Set Workers = Range("Workers")
**For Each WorkerName In Range("Workers")
If WorkerName = Not Nothing Then
Me.cbWorkers.AddItem WorkerName
End If
End sub
I've also been trying to get it alternatively from ThisWorkbook, but I'm getting a 'run-time error 91, object variable or with block variable not set', right after **WorkerName.
Sub UsingTheScriptingRunTimeLibrary()
Dim fso As Scripting.FileSystemObject
Dim fileMakoret As Scripting.File, filePayroll As Scripting.File
Dim WorkerName As String, folderPath As String, NewFolderPath As String
Dim wsControl As Worksheet
Dim newWbMaskoret As Workbook, wbPayroll As Workbook, wbControl As Workbook
Dim cbWorkers As ComboBox
Set wbControl = ActiveWorkbook
Set wsControl = wbControl.Sheets("Control")
**WorkerName = cbWorkers.Value
WorkerName = Worksheets("wsControl").OLEObjects("cbWorkers").Object.Value
Your help is much appreciated.
Does the object frmWorkerName have a Value property? What type of object is it?
I think the problem with your second code snippet is that you define cbWorkers, but you never assign a value to it. It therefore has a value of Nothing ("null" in other languages.)
When you then try to access the value of cbWorkers, you get an error, since there is no object there to access a property for.
ETA: About your second problem: here's the code:
Dim Workers As Range
Dim WorkerName As String
Set Workers = Range("Workers")
For Each WorkerName In Range("Workers")
You're getting the error because, to do a For Each loop, the type of the variable WorkerName needs to be compatible with the type of the collection Range("Workers") that you're iterating through.
The error message tells you: you need to make WorkerName an Object or a Variant if you're going to use it in a For Each loop with that collection.
I doubt, by the way, that the elements in an Excel Range object are simple strings. They are probably Cell objects, or objects of a type with a similar name. You will need to cast WorkerName to type Cell (or whatever) within the loop, and then access its Text or Value property.
I am attempting to store xml metadata within chart shapes in a PowerPoint presentation.
I need to ensure that the shape only contains the current xml data, so I have a function to delete existing data (if any) and add the current data.
Sub Test()
Dim cht as Chart
Dim xml as String
Set cht = ActivePresentation.Slides(1).Shapes(1)
xml = "<Chart property1='true' property2='false'>blah blah blah</Chart>"
EmbedChartXML xml, cht
End Sub
Sub EmbedChartXML(xml As String, cht As Shape)
Dim x As Variant
'Get rid of any previous data
For Each x In cht.CustomerData
x.Delete
Next
Set xmlPart = cht.CustomerData.Add
xmlPart.LoadXML xml
End Sub
The For Each loop is failing with the indicated error message. I can see that the cht.CustomerData.Count = 2 (for example), but if I try to view this in the Locals window, I get the same error.
UPDATE
Here is another test routine that is failing, even though there is nothing inside the For/Next loop.
Sub TestIteration()
Dim sld As Slide
Dim pres As Presentation
Dim shp As Shape
Dim x As CustomXMLPart
Set pres = ActivePresentation
Set sld = pres.Slides(2)
For Each shp In sld.Shapes
Set pptCustomerData = shp.CustomerData
For Each x In shp.CustomerData
' For Each pptCustomXMLPart In pptCustomerData
' Debug.Print pptCustomXMLPart.Id
' Next
Next
Next
End Sub
Others here cannot replicate this error in Excel 2013 (I am using Excel 2010) where the collection object itself becomes inaccessible. Perhaps there is a bug or something, but I could not find much on Google about similar errors...
I ultimately arrive at this solution. I am not sure why the CustomXMLPart's .Delete method doesn't actually delete the item from the collection (instead it makes it to Nothing, and then failure on successive iteration attempts).
Instead, I use the CustomerData.Delete method. This seems to be working as expected.
Sub EmbedChartXML(xml As String, cht As Shape)
Dim x As Variant
Dim cData As CustomerData
Dim xID As String
Set cData = cht.CustomerData
Debug.Print cht.CustomerData.Count
'Get rid of any previous data
For Each x In cData
xID = x.Id
cData.Delete xID
Next
With cData.Add
.LoadXML xml
End With
Debug.Print cht.CustomerData.Count
End Sub
I am really struggling with this, I don't seem to be able to find the reason for my code not working:
Dim i1 As Integer
Dim PPapp As Object, XLapp As Object
Dim slide1 As Slide, slide2 As Slide, slide3 As Slide
Dim PPoutput As Presentation
Dim output_table As ShapeRange
Set PPapp = New PowerPoint.Application
Set XLapp = Excel.Application
Set PPoutput = PPapp.Presentations.Open("Q:\SDPMaler\blank.potx", untitled:=msoTrue, withwindow:=msoTrue)
Set slide1 = ppoutput.Slides.AddSlide(1, ppoutput.SlideMaster.CustomLayouts(13))
XLapp.ActiveWorkbook.Sheets("PPT output").Range("y4:ae11").Copy
Set output_table = slide1.Shapes.PasteSpecial(ppPasteJPG, msoFalse, "", 1, "", msoTrue)
And here my code fails: The macro creates the powerpoint, adds the slide in the right layout and even pasts the table as picture
.PasteSpecial(DataType:=ppPasteOLEObject, link:=msoTrue)
works the same way, but with either I get "Run-time error '13': Type mismatch" on the last row of the pasted code. Even though #13 is usually an easy error to find I am really stuck this time.
Hope someone can help me
Thanks
P.S.: II am using Office 2010 and am running the macro in Excel
My guess:
Change this:
Dim output_table As ShapeRange
To:
Dim output_table As PowerPoint.ShapeRange
assuming you've set a reference to PowerPoint, or
Dim output_table As Object
if you're using late binding
By dimming it as ShapeRange in Excel, you're creating a variable to hold an Excel shaperange, but when you paste into PPT, you get a PowerPoint shaperange, which would lead to a type mismatch.
I'm guessing that the .PasteSpecial function does not return a ShapeRange so when you try to assign the result of .PasteSpecial to variable (output_table) declared as a ShapeRange object you get a type mismatch.
Try Dim output_table as Variant and then debug it by looking at TypeName(output_table) -- if you even NEED the result of PasteSpecial.