vba: return dictionary from function - vba

this outlines what i am trying to do.
this is not working for me, and it is unclear why.
thank you in advance for any and all help.
Sub mySub()
dim myDict as Dictionary
myDict=new Dictionary
myDict=myFunc()
End Sub
Function myFunc()
dim myDict2
set myDict2 = new Dictionary
'some code that does things and adds to myDict2'
myFunc=myDict2
End Function

You'll need to use the SET keyword anytime you are assigning an object instead of a value:
Sub mySub()
dim myDict as Dictionary
set myDict = myFunc()
End Sub
Function myFunc() as Dictionary
dim myDict2 as Dictionary
set myDict2 = new Dictionary
'some code that does things and adds to myDict2'
set myFunc=myDict2
End Function
Your original code was also creating myDict as a new Dictionary object, then immediately replacing it with a different one. You can just skip that step.

I see that this is an old question, but the post AND solution helped me figure this out, and I took it to the next level. It was a small leap. Thank you!
How about converting your function that populates the dictionary with process names and IDs so it returns a dictionary object? Then it is a simple task of populating a sheet with the dictionary contents, which I learned to do from a blog. I wish I had the author's name but the link is included.
Sheet1 was assumed of course. Customize however you wish. Again this was a small leap from what both of you posted. Absolutely brilliant work guys, thank you!
Sub Test_AllRunningApps()
Dim apps As Dictionary
Set apps = AllRunningApps()
'Populate a sheet with a dictionary - http://exceldevelopmentplatform.blogspot.com/2018/05/vba-writing-dictionaries-to-worksheet.html
Sheet1.Cells(1, 1).Resize(apps.Count, 1).Value2 = Application.Transpose(apps.Keys)
Sheet1.Cells(1, 2).Resize(apps.Count, 1).Value2 = Application.Transpose(apps.Items)
Set apps = Nothing
End Sub
'Similar to: http://msdn.microsoft.com/en-us/library/aa393618%28VS.85%29.aspx
Public Function AllRunningApps() As Dictionary
Dim strComputer As String
Dim objServices As Object, objProcessSet As Object, Process As Object
Dim oDic As Object, oDic2 As Object, a() As Variant
Set oDic = CreateObject("Scripting.Dictionary")
strComputer = "."
Set objServices = GetObject("winmgmts:\\" _
& strComputer & "\root\CIMV2")
Set objProcessSet = objServices.ExecQuery _
("Select Name, ProcessID FROM Win32_Process", , 48)
For Each Process In objProcessSet
If Not oDic.exists(Process.Name) Then
oDic.Add Key:=Process.Properties_("Name").Value, Item:=Process.Properties_("ProcessID").Value
End If
Next
Set AllRunningApps = oDic
Set objProcessSet = Nothing
Set oDic = Nothing
End Function

Related

Catia Listbox items

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

VBA - Storing a range into a Range Property on a user class

I have a class that has the following definition:
Private pvtRngTest1 As Range
Public Property Get RngTest1() As Range
Set RngTest1 = pvtRngTest
End Property
Public Property Set RngTest1(ByVal rng As Range)
Set pvtRngTest1 = rng
End Property
When I'm using this class, I'm trying:
Sub FindAllTablesOnSheet(oSh As Worksheet)
Dim oLo As ListObject
For Each oLo In oSh.ListObjects
MsgBox "Table found: " & oLo.Name & ", " & oLo.Range.Address
Dim sr As SheetRanges
Set sr = New SheetRanges
Set sr.RngTest1 = oLo.Range
MsgBox sr.RngTest1.Address
Next
End Sub
I get an error: Object Required (on the last line within the Next statement)
Can someone please help explain? I believe I'm setting the Range property correctly, I get no error when I set it, but then I cannot access the Address of that property.
As https://stackoverflow.com/users/3598756/user3598756 said above, it was typo. Been about 10 years since I looked at VBA and overlooked the benefits of Option Explicit. :S

Can't get value from DatePicker

I have a DatePicker control on a worksheet. When I'm in the embedded code for the worksheet, I can access the control's value as follows:
Public Sub showValue()
Debug.Print Me.DTPicker21.value
End Sub
I would like to get the value from a module. Code here:
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.value
End If
Next
End Sub
When I run this, the obj.value triggers this error:
Object doesn't support this property or method
I checked the list of properties for obj using this procedure, and there is no value property. How can I get the date value that's been set in the DatePicker?
I don't know all of the details, but some of the OLEObjects require that you first access their Object property, then you can access other properties. I think the OLEObject serves as a container, then the "sub-object" is the actual object with which you want to interact. For example, if you run the following two lines of code, you will see that the first returns OleObject and the second returns DTPicker:
Debug.Print "Obj: " & TypeName(obj)
Debug.Print "Obj.Object: " & TypeName(obj.Object)
In your case, try the following code change to remove the error(note the Debug line):
Sub getDate()
Dim obj As Object
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("Tool interface")
For Each obj In sht.OLEObjects
If obj.Name = "DTPicker21" Then
Debug.Print obj.Object.Value
End If
Next
End Sub

Refactor code to break links so Variant type is not used

How do I refactor the following sub-routine so it does not use the Variant data type?
Sub BreakAllLinks()
Dim Link As Variant
Dim myLinks As Variant
myLinks = Excel.ActiveWorkbook.LinkSources(Type:=Excel.xlLinkTypeExcelLinks)
For Each Link In myLinks
Excel.ActiveWorkbook.BreakLink Name:=Link, Type:=Excel.xlLinkTypeExcelLinks
Next Link
End Sub
Here's how you could do it with no Variants - but you shouldn't.
Sub BreakAllLinks()
Dim myLinks() As String
Dim LinkIdx As Long
Dim Link As String
ReDim myLinks(1 To UBound(ActiveWorkbook.LinkSources(xlLinkTypeExcelLinks)))
For LinkIdx = LBound(myLinks) To UBound(myLinks)
myLinks(LinkIdx) = ActiveWorkbook.LinkSources(xlLinkTypeExcelLinks)(LinkIdx)
Next LinkIdx
For LinkIdx = LBound(myLinks) To UBound(myLinks)
Link = myLinks(LinkIdx)
ActiveWorkbook.BreakLink Link, xlLinkTypeExcelLinks
Next LinkIdx
End Sub
That's a little over-the-top on purpose to demonstrate all the data types involved. You can only For..Each an array with a Variant - it's just how the language is written. The best practice isn't 'don't use Variants' but rather 'Use the most restrictively typed variable that you can'. In your case, the Variant is the most restrictively typed variable you can use.
There is a way to write that without Variants and not so obviously crazy
Sub BreakAllLinks()
Dim LinkIdx As Long
For LinkIdx = LBound(ActiveWorkbook.LinkSources(1)) To UBound(ActiveWorkbook.LinkSources(1))
ActiveWorkbook.BreakLink ActiveWorkbook.LinkSources(1)(1), xlLinkTypeExcelLinks
Next LinkIdx
End Sub
But even then, I'd opt for the Variant. It's worth the trade off.
A Linksource is a String.
But why bother ?
Sub M_snb()
For Each it In ActiveWorkbook.LinkSources(1)
MsgBox = TypeName(it)
ActiveWorkbook.BreakLink it, 1
Next
End Sub

Setting value of named range in Excel

I apologize if this is a total noob question. I'm in the process of writing an addin for Excel. I have a sub inside class1 that opens an excel file, in this sub I have a reference to sub2 which is below. All I am looking to do is hook into the active instance of Excel, change a named range value and exit. But I keep getting errors no matter which way that I try. Here is what I have. Tell me where I have gone wrong. Forgot to mention, this is in VB.NET.
Private Sub SetRangeValue(ByVal RangeName As String, ByVal RangeValue As String)
Dim ExcelApp As Excel.Application
Dim TheRange As Excel.Range
Dim TheRangeName As String = ""
'Hook into running excel instance
ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
'First Attempt Here
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.Value = RangeValue
'Second Attempt
TheRange = ExcelApp.Range(RangeName)
TheRange.Value = RangeValue
End Sub
I can't get either one to work. Any help is appreciated.
Finally I got this to work properly. This is how it needed to work. Thanks for all the help.
Private Sub SetRangeValue(ByVal RangeName As String, ByVal RangeValue As String)
Dim ExcelApp As Excel.Application
'Dim TheRangeObj As Excel.Range
Dim TheRange As Microsoft.Office.Interop.Excel.Name
Dim TheRangeName As String = ""
'Hook into running excel instance
ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.RefersToRange.Value = RangeValue
End Sub
'First Attempt Here
TheRange = ExcelApp.ActiveWorkbook.Names.Item(RangeName)
TheRange.Value = RangeValue
According to Names.Item Method (Excel), this function returns a single Name object from a Names collection. In this case TheRange is not valid name for this variable, it should be TheName. Then
TheName.Value = RangeValue
is not right assignment; According to Name.Value Property (Excel) this property - Returns or sets a String value that represents the formula that the name is defined to refer to.
Error 0x800A03EC, there are a number of reasons this error is returned from Excel - the most common is when attempts to write data larger than Excel can handle. For example, you try to write a string longer than 1024 characters to a cell in Excel
I just made a sub that would make it easier me to find & replace using my named ranges:
Private Sub XlFindReplace(ByRef xSheet As Excel.Worksheet, ByVal cellName As String, ByVal NewText As String)
xSheet.Range(cellName).Value = NewText
End Sub
then T'd call it like this in order to replace stuff:
XlFindReplace(xlC1Sheet, "client1Co1Tax", client1Co1Tax)
where the xlC1Sheet is the sheet I'm currently
the "client1Co1Tax"is the name of the range in excel
and client1Co1Tax is the string variable I'm replacing it
Thanks to everyone for their input.