I'm using the following example code to get an OLEObject by name. I keep getting error "Object name not found". I'm a fairly experienced Visio/VBA developer. This has me stumped.
Private Sub zzz()
Dim vsoPage as Visio.Page
Set vsoPage = ThisDocument.Pages("Patching")
Dim oObject as Visio.OLEObject
Set oObject = vsoPage.OLEObjects("cmdOpenPatchTool")
End sub
I cut & pasted the name from the command button so I know it's correct. To workaround whatever is causing this problem, I wrote this function. It works fine. I just want to figure this out.
Private Function getOLEObjectOnPage( _
vsoPage as Visio.Page, _
strObjectName as String) as Object
Dim vsoOLEObjects as Visio.OLEObjects
Set vsoOLEObjects = vsoPage.OLEObjects
Dim Obj as Object
For Each Obj in vsoOLEObjects
If Obj.Object.Name = strObjectName Then
Set getOLEObjectOnPage = Obj
Exit For
End if
Next Obj
End Function
a very naive suggestion for debugging:
iterate over the oleobjects and debug.print their name
just to check the name does really exist
The shape may have different Name and NameU attributes. Look at the object's Name and NameU and see if they are different.
The names exist. I use a macro that cycles though pages and exports to an Excel spreadsheet Visio Shape and OLE Object details. For Objects, I export the Object.Name (unlike a Shape, an OLE Object does not have a .NameU property), ObjectType, Shape.ClassID), and many ShapeSheet details (e.g., PinX, PinY, LockDelete, LockText,). I do the same thing for Shapes.
I built and maintain a fairly complex electronic system design document (eSDD). It is used to capture the logical and physical design, technical specifications, deployment details, and build instructions for applications and systems, and all of their VMs that are maintained in Azure and on-prem. Extracts from this tool are used to automate the commissioning and decommissioning of VMs.
When the UI or functionality changes, existing eSDDs (of which there are over 300) need to be patched. In many cases, I use the exported file to drive "Patch Tools" macros used to create, rename, format, and delete shapes, and to migrate ShapeData.
I'm trying to optimize patching so that I don't have to cycle though every OLEObject on a page to find the one I need.
Here is a document containing an embedded OLE object with different .Name and .NameU
Have you tried removing the dbl quotes from around the "cmdOpenPatchTool"?
Paul, the Visio file has a rectangular shape. I didn't find an OLE Object (e.g., Textbox, Combobox, or CommandButton).
Wapperdude, without the quotes, the compiler generates a "variable not found" error.
As I said, this has me stumped.
The shape is an OLE object.
A TextBox, ComboBox etc are Controls, these can be inserted via the Developer ribbon, not the Insert ribbon.
Anyway, example attached with such a shape with different .Name and .NameU
Paul, in my example, I use oObject as the top level object. In the Locals window, oObject has Object, Shape, and ShapeObject tree limb items.
- The Object limb has a Name property, but no NameU property
- The Shape limb has a Name and NameU property, but they contain generic OLEObject names and not the object's defined name
- The ShapeObject limb has Name property, but no NameU property. In this case, however, the Name property contains the object's defined name
Having said that, I'm going to futz with this a bit more. Ultimately, I want to parse through an Excel worksheet and substitute "cmdOpenPatchTool" with a variable so that I can apply updates using metadata.
Dim oObject as Visio.OLEObject
Set oObject = vsoPage.OLEObjects("cmdOpenPatchTool")
Regards,
Johnnie
Quote= vsoPage.OLEObjects("cmdOpenPatchTool")
Looking at the Visio object model, I cannot find anything that would support this syntax. So, I also played around with a variety of possibilities. Again, nothing that comes close to that exact syntax. As you've shown, there are work-arounds. Iterating thru the page is not such a bad idea...it will determine if desired object is even on the page. Otherwise, you need some sort of error trapping. Here's some code that I tried...there were additional iterations, none of which worked, so, this catches the basic concepts.
Sub whoAmI()
Dim vShp As Visio.Shape
Dim oObj As Visio.OLEObject
Dim spObj1 As Visio.OLEObject
Dim spObj2 As Visio.OLEObject
Dim spObj3 As Visio.OLEObject
Dim oObjs As Visio.OLEObjects
Set oObjs = ActivePage.OLEObjects
For Each vShp In ActivePage.Shapes
Debug.Print vShp.Name
Debug.Print vShp.NameU
Next
Debug.Print "**********"
For Each oObj In ActivePage.OLEObjects
Debug.Print TypeName(oObj.Object)
Debug.Print oObj.Object.Name
Set spObj1 = oObj
Debug.Print "spObj1 =", spObj1.Object.Name
Set spObj2 = ActivePage.OLEObjects(1)
Debug.Print "spObj2 =", spObj2.Object.Name
' Set spObj3 = ActivePage.OLEObjects("ComboBox1")
' Set spObj3 = ActivePage.OLEObjects("{8BD21D30-EC42-11CE-9E0D-00AA006002F3}")
' Debug.Print "spObj3 =", spObj3.Object.Name
Next
Debug.Print "**********"
For intCounter = 1 To oObjs.Count
Debug.Print oObjs(intCounter).ClassID
Debug.Print oObjs(intCounter).ProgID
Debug.Print oObjs(intCounter).Object.Name
' Debug.Print Object("{8BD21D30-EC42-11CE-9E0D-00AA006002F3}")
Next intCounter
End Sub
I don't think you need to go the literal OLE route to do what you want. Just a guess on my part...not enough detail to justify the validity of the statement. Just saying...
wapperdude
This
Quote= vsoPage.OLEObjects("cmdOpenPatchTool")
Came from the OLEObjects.Item property information at https://docs.microsoft.com/en-us/office/vba/api/visio.oleobjects.item where is shows "expression.Item(NameOrIndex)." I used the syntax with and without .Item. I figured it meant I could use the name of the object. Maybe so, but I can't get it to work that way.
What started me down this rabbit hole was when I had to delete several textbox and combobox objects, and recreate others - using my patching tool. I wanted to find objects using their name as opposed to cycling. Cycling is very fast, so it's no big deal. For data entry/data protection reasons, I have various objects on different layers. So I only have to cycle through objects on a particular layer, which speeds things up a bit.
I do have a routine that checks to make sure an object doesn't exist before I create it. I have other's that check to make sure a Layer, Page, Shape, etc.., exists before I try to use them. I started leaning VBA, Visio VBA and Excel VBA about three years. I learned through the school of hard knocks how important that was :).
Thanks for your help, and to everyone else that chimed in.
Updated the macro to grab various object/shape identifiers. Also shows variety of syntax constructions that actually work.
Sub whoAmI()
Dim oObj As Visio.OLEObject
Dim myObj As Visio.OLEObject
Dim visCmbBx As Visio.Shape
For Each oObj In ActivePage.OLEObjects
Debug.Print "<<<<<>>>>>"
Set visCmbBx = oObj.Shape
Debug.Print visCmbBx.Name
Debug.Print visCmbBx.NameU
Set myObj = ActivePage.OLEObjects(visCmbBx.Name)
Debug.Print myObj.Object.Name
Debug.Print "#############"
With oObj.Object
Debug.Print TypeName(.Object)
Debug.Print .Name
Debug.Print .ClassID
Debug.Print .ProgID
End With
With oObj
objName = TypeName(.Object)
Select Case objName
Case Is = "ComboBox"
Debug.Print "I am a combo box!"
With .Object. 'edit box properties
.BackColor = RGB(200, 200, 255)
.Font.Name = "DomCasual BT"
.Font.Size = 12
.AutoSize = True
End With
End Select
End With
Next
End Sub
After doing a bit more research, I found my answer using CallByName. It allows me to directly get a ThisDocument ActiveX object by name without having to cycle through all objects on a page or all objects in the document to find a particular control.
Private Sub aaa()
Dim vsoDocument As Visio.Document
Set vsoDocument = ThisDocument
Dim strObjectName As String
strObjectName = "txtGPMEmail"
'// Get a ThisDocument ActiveX control by name
Dim Obj As Object
Set Obj = getThisDocumentObject( _
vsoDocument, _
strObjectName)
If Not Obj Is Nothing Then
On Error GoTo exitHere
'// Set Object properties
CallByName Obj, "fontsize", VbLet, 12
CallByName Obj, "fontname", VbLet, "Arial"
CallByName Obj, "fontbold", VbLet, True
Dim vsoShape As Visio.Shape
Set vsoShape = Obj.Shape
Debug.Print vsoShape.Cells("PinX").ResultStr("")
Debug.Print vsoShape.Cells("PinY").ResultStr("")
Debug.Print vsoShape.Cells("Width").ResultStr("")
Debug.Print vsoShape.Cells("Height").ResultStr("")
If vsoShape.LayerCount > 0 Then
Debug.Print vsoShape.Layer(1).Name
End If
End If
exitHere:
On Error GoTo 0
End Sub
Public Function getThisDocumentObject( _
vsoDocument As Visio.Document, _
strObjectName As String) As Object
On Error GoTo exitHere
Set getThisDocumentObject = CallByName(vsoDocument, strObjectName, VbGet)
exitHere:
On Error GoTo 0
End Function
@OldSchool1948: nice find regarding CallByName function.
Code has been updated to demonstrate searching by page, by document, using case statements to filter results, using CallByName function...both globally and object specific.
Sub whoAmI()
'There are three major sections within this module:
'1: Code that searches thru each page
' This includes case statements to "filter" specific objects. More "global" than
' the CallByName function.
' This code also shows OLE Object can have both a shape and an OLE identity.
'2: Code that searches thru the document
'3: Code that uses the CallByName function. Credit to OldSchool1948 for discovery of this function
'
'The CallByName function is useful if you know the specific object in question
'The document search is helpful to find the specific object names, should you not know.
'The page search can be a limited search or can be a document-wide search
Dim oObj As Visio.OLEObject
Dim myObj As Visio.OLEObject
Dim visCmbBx As Visio.Shape
' The following code line search each page withing the document:"
For Each pg In ActiveDocument.Pages
Debug.Print "===== ", pg.Name, " ====="
For Each oObj In pg.OLEObjects
Debug.Print "<<<<< As Shape Object >>>>>"
Set visCmbBx = oObj.Shape
Debug.Print visCmbBx.Name
Debug.Print visCmbBx.NameU
Set myObj = pg.OLEObjects(visCmbBx.Name)
Debug.Print myObj.Object.Name, "Shape.NameU"
Debug.Print "####### As OLE Object #######"
With oObj.Object
Debug.Print TypeName(.Object)
Debug.Print .Name, "Object.Name"
Debug.Print .ClassID
Debug.Print .ProgID
End With
'Filtering results using Case statements:
With oObj
objName = TypeName(.Object)
Select Case objName 'Only one case is shown. Add more as needed
Case Is = "ComboBox" 'This does only ALL combo boxes and ignores other OLE objects.
With .Object
.BackColor = RGB(255, 255, 0)
.Font.Name = "DomCasual BT"
.Font.Size = 12
.AutoSize = True
End With
End Select
End With
'Syntax, using CallByName function:
'
' CallByName myObj.Object, "fontsize", VbLet, 24 'This works...ALL objects in doc / on page
' CallByName oObj.Object, "FontSize", VbLet, 12 'This works...ALL objects in doc / on page
' CallByName ComboBox1, "FontSize", VbLet, 12 'This works...a specific ComboBox
' CallByName ComboBox2, "fontsize", VbLet, 18 'This works...a specific ComboBox
Next
Debug.Print ""
Next
'Document search code:
Debug.Print ""
Debug.Print "///// Document Objects \\\\\"
Debug.Print "Number of OLEObjects = ", ActiveDocument.OLEObjects.Count
For Each oObj In ActiveDocument.OLEObjects
With oObj.Object
Debug.Print TypeName(.Object)
Debug.Print .Name, "Object.Name"
Debug.Print .ClassID
Debug.Print .ProgID
End With
Next
End Sub
This macro will go through a Visio file and write all shapes and objects to an Excel worksheet. I use it to make maintenance of my application data driven for many things. I hope folks will find it useful. @wapperdude thanks for introducing me to TypeName. I was using ClassID, this is much cleaner.
Private Sub exportShapeAndObjectInfo()
On Error GoTo errHandler
Dim strFileName As String
strFileName = "ShapeAndObjectInfo"
Dim FilePath As String
FilePath = Visio.ActiveDocument.Path & strFileName & C_FILE_EXT_XLSX
Dim xlApp_Dest As Excel.Application
Set xlApp_Dest = CreateObject("Excel.Application")
xlApp_Dest.Visible = False
xlApp_Dest.DisplayAlerts = False
Dim xlWb_Dest As Excel.Workbook
Set xlWb_Dest = xlApp_Dest.Workbooks.Add(Excel.xlWBATWorksheet)
On Error Resume Next
Err.Clear
xlWb_Dest.SaveAs FileName:=FilePath
If Err.Number = 1004 Then
xlWb_Dest.Close
Set xlApp_Dest = Nothing
Dim strMsg
strMsg = "One of these errors occured while trying to create the extract file:" & C_SPACE & vbCrLf & vbCrLf & _
" (1) The filename contains invalid characters, or" & vbCrLf & _
" (2) An Excel file is opended with the same name you are using." & vbCrLf & vbCrLf & _
"Please correct this error before trying again."
MsgBox strMsg
GoTo exitHere
End If
On Error GoTo 0
Dim xlWs_Dest As Excel.Worksheet
Set xlWs_Dest = xlWb_Dest.Sheets("Sheet1")
xlWs_Dest.Name = "ShapeInfo"
xlWs_Dest.Activate
With xlWs_Dest
.Cells(1, 1) = "Page Name"
.Cells(1, 2) = "ShapeName"
.Cells(1, 3) = "ShapeText"
.Cells(1, 4) = "PinX"
.Cells(1, 5) = "PinY"
.Cells(1, 6) = "Width"
.Cells(1, 7) = "Height"
.Cells(1, 8) = "LockDelete"
.Cells(1, 9) = "LockTextEdit"
.Cells(1, 10) = "LockWidth"
.Cells(1, 11) = "LockHeight"
.Cells(1, 12) = "LockMoveX"
.Cells(1, 13) = "LockMoveY"
.Cells(1, 14) = "LockSelect"
.Cells(1, 15) = "Layer"
.Cells(1, 16) = "ObjectType"
.Cells(1, 17) = "ObjectClass"
Dim c As Integer
c = 2
Dim vsoPage As Visio.Page
For Each vsoPage In ThisDocument.Pages
Dim vsoShape As Visio.Shape
For Each vsoShape In vsoPage.Shapes
.Cells(c, 1) = vsoPage.Name
.Cells(c, 2) = vsoShape.Name
.Cells(c, 3) = vsoShape.Characters
.Cells(c, 4) = vsoShape.Cells("PinX").ResultStr("")
.Cells(c, 5) = vsoShape.Cells("PinY").ResultStr("")
.Cells(c, 6) = vsoShape.Cells("Width").ResultStr("")
.Cells(c, 7) = vsoShape.Cells("Height").ResultStr("")
.Cells(c, 8) = vsoShape.Cells("LockDelete").ResultStr("")
.Cells(c, 9) = vsoShape.Cells("LockTextEdit").ResultStr("")
.Cells(c, 10) = vsoShape.Cells("LockWidth").ResultStr("")
.Cells(c, 11) = vsoShape.Cells("LockHeight").ResultStr("")
.Cells(c, 12) = vsoShape.Cells("LockMoveX").ResultStr("")
.Cells(c, 13) = vsoShape.Cells("LockMoveY").ResultStr("")
.Cells(c, 14) = vsoShape.Cells("LockSelect").ResultStr("")
If vsoShape.LayerCount > 0 Then
.Cells(c, 15) = vsoShape.Layer(1).Name
End If
c = c + 1
Next vsoShape
Dim Obj As Object
For Each Obj In vsoPage.OLEObjects
Set vsoShape = Obj.Shape
.Cells(c, 1) = vsoPage.Name
.Cells(c, 2) = Obj.Object.Name
Dim strObjText As String
strObjText = ""
Select Case TypeName(Obj.Object)
Case "Label"
strObjText = Obj.Object.Caption
Case "ComboBox"
strObjText = Obj.Object.Value
Case "CommandButton"
strObjText = Obj.Object.Caption
Case "TextBox"
strObjText = Obj.Object.Value
End Select
If strObjText <> "" Then
.Cells(c, 3) = strObjText
.Cells(c, 4) = vsoShape.Cells("PinX").ResultStr("")
.Cells(c, 5) = vsoShape.Cells("PinY").ResultStr("")
.Cells(c, 6) = vsoShape.Cells("Width").ResultStr("")
.Cells(c, 7) = vsoShape.Cells("Height").ResultStr("")
.Cells(c, 8) = vsoShape.Cells("LockDelete").ResultStr("")
.Cells(c, 9) = vsoShape.Cells("LockTextEdit").ResultStr("")
.Cells(c, 10) = vsoShape.Cells("LockWidth").ResultStr("")
.Cells(c, 11) = vsoShape.Cells("LockHeight").ResultStr("")
.Cells(c, 12) = vsoShape.Cells("LockMoveX").ResultStr("")
.Cells(c, 13) = vsoShape.Cells("LockMoveY").ResultStr("")
.Cells(c, 14) = vsoShape.Cells("LockSelect").ResultStr("")
If vsoShape.LayerCount > 0 Then
.Cells(c, 15) = vsoShape.Layer(1).Name
End If
.Cells(c, 16) = TypeName(Obj.Object)
.Cells(c, 17) = Obj.ClassID
c = c + 1
End If
Next Obj
Next vsoPage
End With
exitHere:
' If isObjectConnected(xlApp_Dest) Then xlApp_Dest.Visible = True
If c > 2 Then
'*************************************
'// Sort Worksheet
'*************************************
Dim strMaxCol As String
strMaxCol = "Q"
With xlWs_Dest
Dim xlLastRow As Long
xlLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Dim tgtRange As Excel.Range
Set tgtRange = .Range( _
"A1:" & _
strMaxCol & _
xlLastRow)
tgtRange.AutoFilter Field:=1, _
VisibleDropDown:=True
.Activate
.UsedRange.Columns.AutoFit
.UsedRange.Rows.AutoFit
.UsedRange.VerticalAlignment = xlTop
.Range("A1:" & strMaxCol & "1").Interior.Color = RGB(189, 215, 238)
.Range("A1:" & strMaxCol & "1").Font.Bold = True
.Range("A2").Select
End With
xlApp_Dest.Visible = True
End If
On Error GoTo 0
Exit Sub
errHandler:
' If isObjectConnected(xlApp_Dest) Then
' xlWb_Dest.Close savechanges:=False
' xlApp_Dest.DisplayAlerts = True
' xlApp_Dest.Quit
' Set xlApp_Dest = Nothing
' End If
'
' Call showProgramError
Resume exitHere
End Sub
In the above macro, C_FILE_EXT_XLSX = ".xlsx"
Public Const C_FILE_EXT_XLSX As String = ".xlsx"