Problem: I want to create a function that gets one string and returns a dictionary.
After much reading in SO I reproduced exactly the code given in some questions and I end up with a solution that looks to work. But there are things that I dont understand.
here the code which is a bit long because includes some comments:
Private Sub testdictionary()
Dim dict_in_sub As Scripting.Dictionary
' Do I really need this??:
'Set dict_in_sub = New Scripting.Dictionary
' or this:
'Set dict_in_sub =CreateObject("Scripting.Dictionary")
Call returning_dict_func("word1.word2")
Set dict_in_sub = returning_dict_func("whatever.second")
MsgBox "in code:" & Chr(10) & dict_in_sub("A") & Chr(10) & dict_in_sub("B")
End Sub
This is the function called:
Function returning_dict_func(SC As String) As Scripting.Dictionary
' should this function return a dictionary or an object or a scrippting dictionary??
Dim dictionary_in_function
Set dictionary_in_function = CreateObject("Scripting.Dictionary")
'take the first and second part of the string separated by the period
dictionary_in_function("A") = Mid(SC, 1, InStr(SC, ".") - 1)
dictionary_in_function("B") = Mid(SC, InStr(SC, ".") + 1, Len(SC))
MsgBox dictionary_in_function("A") & Chr(10) & dictionary_in_function("B")
Set returning_dict_func = dictionary_in_function
End Function
Even if I got the code running, there are a few things that make returning a dict from a function in VBA strange
Introducing the following changes into the code make it not working:
Dim dict_in_sub as Dictionary
' it does not work. What is the difference between dictionary and scrippting.dictionary?
' defining the function as returning a dictionary does not work
Function returning_dict_func(SC As String) As Dictionary
' if both are dictionaries it does not work
Dim dict_in_sub as Dictionary
Function returning_dict_func(SC As String) As Dictionary
Why is dictionary different than scripting.dictionary?
When should you initialize with
Set dict_modifiers = CreateObject("Scripting.Dictionary")
thanks
Note:
I had a look to:
a) VBA in Excel 2010: Scripting.Dictionary return value of a function won't pass as parameter to a wrapping function call
b) Returning dictionary from function in vba. Error 450
c) Returning an dictionary object from a function in VBA
The difference between CreateObject and New is briefly you need to reference a library with the object (Microsoft Scripting Runtime) for the latter (New), and you don't need to reference anything using CreateObject.
You can also have some intellisense hints when you use the latter definition, as the type is declared and known.
You can find more in another answer: What are the differences between using the New keyword and calling CreateObject in Excel VBA?
As for the Dictionary object, Scripting.Dictionary is the right type to use. Read more about it in https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/dictionary-object.
And by the way, in VBA you have to assign variables values using Set when the value is an object (usually something different than a number or String or Date).
Related
I have an array of combinations called "Keys". I want to check if each combination exists in the column I, and if so, split the existing combination in 2 strings and add them as a pair in my dictionary "combiExist".
My code throws a 457 error
Dim combiExist As Object
Set combiExist = CreateObject("Scripting.Dictionary")
For Each cle In keys
'If combination exists in my range
If Not .Range("I:I").Find(cle) Is Nothing Then
'Split string from 7th position, left part is the key, right part is the value
combiExist.Add Left(cle, 7), Right(cle, 7)
End If
Next
How can I solve this ?
Error 457 says that the key is already associated with an element of the collection. So, before assigning it to the dictionary make sure it is not there, with .Exists.
This one works rather ok, at the end it prints the dictionary:
Sub Main()
Dim combiExist As Object
Set combiExist = CreateObject("Scripting.Dictionary")
Dim combinations As Variant
combinations = Array("joeC12345678910", "C12345678910", "foooooo123")
Dim cle As Variant
For Each cle In combinations
If Not Worksheets(1).Range("I:I").Find(cle) Is Nothing Then
If combiExist.exists(Left(cle, 7)) Then
Debug.Print "Do nothing this one " & (Left(cle, 7)) & " exists!"
Else
combiExist.Add Left(cle, 7), Right(cle, 7)
End If
End If
Next
PrintDictionary combiExist
End Sub
Public Sub PrintDictionary(myDict As Object)
Dim key As Variant
For Each key In myDict.keys
Debug.Print key; "-->"; myDict(key)
Next key
End Sub
In general, do not use words like Keys for a variable name, because this one means something in VBA - usually a collection of the keys of a given dictionary. You can see the implementation of myDict.keys in PrintDictionary().
Beware of voodoo programming
Do
If Inp.AtEndOfStream = True then exit do
Line=Inp.readline
On Error Resume Next
Dict.Add(Line, "")
If err.number = 457 then err.clear
On Error Goto 0
Loop
This is the way one programs. One does and handles it.
The answers given using .exists generates needless function calls. All methods and properties are indirect function calls under the hood. That means stack setup and tear down. There will be a minimum of one function per item, if it's duplicated. But there will be two function calls for unique items.
Testing return values it is only one function per item.
Also remember every . is also a function call.
Remember COM methods/properties look like this
Err.Number = MethodName(Param1, ..., ReturnValue)
Err.Number, called an HResult in COM, returns information about your call.
Embrace errors.
What is on the stack.
The return address, the return value, any parameters (in or out), and all local variables.
In the other answer there is a minimum of 3 function calls or 4 if it does not exists.
My Code is 2 if it exists or not. That is multiplied by the number of items.
I am currently creating a Class Object for a VBA file, its objective is to act as a range dictionary that can be passed single cells. If this cell is contained in one of the ranges, it returns the value associated to the corresponding range key. The class name is "rangeDic".
It is in the making so its functionalities are not implemented yet. Here's the code:
Private zone() As String
Private bounds() As String
Private link As Dictionary
Const ContextId = 33
'Init zone
Private Sub Class_Initialize()
Set link = New Dictionary
ReDim zone(0)
ReDim bounds(0)
End Sub
'properties
Property Get linkDico() As Dictionary
Set linkDico = link
End Property
Property Set linkDico(d As Dictionary)
Set link = d
End Property
Property Get pZone() As String()
pZone = zone
End Property
Property Let pZone(a() As String)
Let zone = a
End Property
'methods
Public Sub findBounds()
Dim elmt As String
Dim i As Integer
Dim temp() As String
i = 1
For Each elmt In zone
ReDim Preserve bounds(i)
temp = Split(elmt, ":")
bounds(i - 1) = temp(0)
bounds(i) = temp(1)
i = i + 2
Next elmt
End Sub
I was trying to instanciate it in a test sub in order to debug mid conception. Here's the code:
Sub test()
Dim rd As rangeDic
Dim ran() As String
Dim tabs() As Variant
Dim i As Integer
i = 1
With ThisWorkbook.Worksheets("DataRanges")
While .Cells(i, 1).Value <> none
ReDim Preserve ran(i - 1)
ReDim Preserve tabs(i - 1)
ran(i - 1) = .Cells(i, 1).Value
tabs(i - 1) = .Cells(i, 3).Value
i = i + 1
Wend
End With
Set rd = createRangeDic(ran, tabs)
End Sub
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
Dim obje As Object
Dim zonesL As Integer
Dim valsL As Integer
Dim i As Integer
zonesL = UBound(zones) - LBound(zones)
valsL = UBound(vals) - LBound(vals)
If zonesL <> valsL Then
Err.Raise vbObjectError + 5, "", "The key and value arrays are not the same length.", "", ContextId
End If
Set obje = New rangeDic
obje.pZone = zones()
For i = 0 To 5
obje.linkDico.add zones(i), vals(i)
Next i
Set createRangeDic = obje
End Function
Take a look at line 2 of Public Function createRangeDic. I have to declare my object as "Object", if I try declaring it as "rangeDic", Excel crashes at line obje.pZone = zones(). Upon looking in the Windows Event Log, I can see a "Error 1000" type of application unknown error resulting in the crash, with "VB7.DLL" being the faulty package.
Why so ? Am I doing something wrong ?
Thanks for your help
Edit: I work under Excel 2016
It looks like this is a bug. My Excel does not crash but I get an "Internal Error".
Let's clarify a few things first, since you're coming from a Java background.
Arrays can only be passed by reference
In VBA an array can only be passed by reference to another method (unless you wrap it in a Variant). So, this declaration:
Property Let pZone(a() As String) 'Implicit declaration
is the equivalent of this:
Property Let pZone(ByRef a() As String) 'Explicit declaration
and of course, this:
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
is the equivalent of this:
Public Function createRangeDic(ByRef zones() As String, ByRef vals() As Variant) As rangeDic
If you try to declare a method parameter like this: ByVal a() As String you will simply get a compile error.
Arrays are copied when assigned
Assuming two arrays called a and b, when doing something like a = b a copy of the b array is assigned to a. Let's test this. In a standard module drop this code:
Option Explicit
Sub ArrCopy()
Dim a() As String
Dim b() As String
ReDim b(0 To 0)
b(0) = 1
a = b
a(0) = 2
Debug.Print "a(0) = " & a(0)
Debug.Print "b(0) = " & b(0)
End Sub
After running ArrCopy my immediate window looks like this:
As shown, the contents of array b are not affected when changing array a.
A property Let always receives it's parameters ByVal regardless of whether you specify ByRef
Let's test this. Create a class called Class1 and add this code:
Option Explicit
Public Property Let SArray(ByRef arr() As String)
arr(0) = 1
End Property
Public Function SArray2(ByRef arr() As String)
arr(0) = 2
End Function
Now create a standard module and add this code:
Option Explicit
Sub Test()
Dim c As New Class1
Dim arr() As String: ReDim arr(0 To 0)
arr(0) = 0
Debug.Print arr(0) & " - value before passing to Let Property"
c.SArray = arr
Debug.Print arr(0) & " - value after passing to Let Property"
arr(0) = 1
Debug.Print arr(0) & " - value before passing to Function"
c.SArray2 arr
Debug.Print arr(0) & " - value after passing to Function"
End Sub
After running Test, my immediate window looks like this:
So, this simple test proves that the Property Let does a copy of the array even though arrays can only be passed ByRef.
The bug
Your original ran variable (Sub test) is passed ByRef to createRangeDic under a new name zones which is then passed ByRef again to pZone (the Let property). Under normal circumstances there should be no issue with passing an array ByRef as many times as you want but here it seems it is an issue because the Property Let is trying to make a copy.
Interestingly if we replace this (inside createRangeDic):
obje.pZone = zones()
with this:
Dim x() As String
x = zones
obje.pZone = x
the code runs with no issue even if obje is declared As rangeDic. This works because the x array is a copy of the zones array.
It looks that the Property Let cannot make a copy of an array that has been passed ByRef multiple times but it works perfectly fine if it was passed ByRef just once. Maybe because of the way stack frames are added in the call stack, there is a memory access issue but difficult to say. Regardless what the problem is, this seems to be a bug.
Unrelated to the question but I must add a few things:
Using ReDim Preserve in a loop is a bad idea because each time a new memory is allocated for a new (larger) array and each element is copied from the old array to the new array. This is very slow. Instead use a Collection as
#DanielDuĊĦek suggested in the comments or minimize the number of ReDim Preserve calls (for example if you know how many values you will have then just dimension the array once at the beginning).
Reading a Range cell by cell is super slow. Read the whole Range into an array by using the Range.Value or Range.Value2 property (I prefer the latter). Both methods returns an array as long as the range has more than 1 cell.
Never expose a private member object of a class if that object is responsible for the internal workings of the class. For example you should never expose the private collection inside a custom collection class because it breaks encapsulation. In your case the linkDico exposes the internal dictionary which can the be modified from outside the main class instance. Maybe it does not break anything in your particular example but just worth mentioning. On the other hand Property Get pZone() As String() is safe as this returns a copy of the internal array.
Add Option Explicit to the top of all your modules/classes to make sure you enforce proper variable declaration. Your code failed to compile for me because none does not exist in VBA unless you have it somewhere else in your project. There were a few other issues that I found once I turned the option on.
I have an array loaded with cell addresses that are passsed into a sub that handles tab order on a sheet. I want to be able to put a control name, i.e. "MyListBox" in that array and have my function handle it. However, I cannot get it to resolve in the .activate method. If I implicitly name the control it will work but I need it to "macro expand / resolve" to the actual control name so I can say Array(x).Activate.
Here is the code I'm fumbling with to no avail. I've tried it with and without the MSFORMs declaration. I've tried concatenating the command "activesheet." & arr(x) and many other things. I'm pretty sure I'm probably missing something simple but can't seem to find it.
Sub TabIntercept()
Dim arr, a, x, nxt, sel
Dim cMyListBox As MSForms.ListBox
If TypeName(Selection) <> "Range" Then Exit Sub 'Exit if (eg) a shape is selected
Set sel = Selection.Cells(1) 'if multiple cells selected use the first...
arr = GetTabOrder(ActiveSheet.Name) 'this function loads the tab order from a table
If UBound(arr) = -1 Then
Application.OnKey "{TAB}"
Exit Sub
End If
For x = LBound(arr) To UBound(arr)
If Left(arr(x), 3) = "lst" Or Left(arr(x), 3) = "cmb" Then 'Look for a control - they all start with lst/cmb
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
arr(x).Activate
End If
If sel.Address() = sel.Parent.Range(arr(x)).Address() Then
'loops back to start if at end...
nxt = IIf(x = UBound(arr), LBound(arr), x + 1)
sel.Parent.Range(arr(nxt)).Select
Exit For
End If
Next x
End Sub
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
First, declare a Worksheet variable for that sheet; the Workbook.Sheets property returns an Object, so all these member calls are implicitly late-bound, and you're coding blindfolded without compiler assistance.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets("Resources & Process")
Note the ActiveWorkbook qualifier: if you have a specific Workbook object to use instead, use that. But consider always qualifying Workbook member calls, otherwise you're implicitly referring to whatever the ActiveWorkbook is, and eventually that will not be the workbook you're expecting.
Now, sheet.arr(x) isn't going to work, as IntelliSense is now showing you when you type that . dot operator: a Worksheet object would have to expose an indexed property named arr for that to work.
What you want to do, is get the OLEObject that is named whatever the value of arr(x) is.
You get OLE objects from the Worksheet.OLEObjects property:
Dim oleControl As OLEObject
Set oleControl = sheet.OLEObjects(arr(x))
If that succeeds, you've found your MSForms control - but it's wrapped in an OLE object and we now just need to unwrap it:
Set cMyListBox = oleControl.Object
If that fails, then the MSForms control isn't compatible with the declared type of cMyListBox. But now you get IntelliSense and compile-time validation for member calls against it: if you type cMyListBox. and there's an Activate member, then the call should be valid at run-time.
I have different Collections in my code. Some hold Objects (of various kinds), others have types (like Long) within them.
Is there a way to check if a key is contained in the Collection that works for types as well as objects?
So far I have two functions.
First function:
Private Function ContainsObject(objCollection As Object, strName As String) As Boolean
Dim o As Object
On Error Resume Next
Set o = objCollection(strName)
ContainsObject = (Err.Number = 0)
Err.Clear
End Function
Second function:
Private Function ContainsLong(AllItems As Collection, TheKey As String) As Boolean
Dim TheValue As Long
On Error Resume Next
TheValue = AllItems.Item(TheKey)
ContainsLong = (Err.Number = 0)
Err.Clear
End Function
The reason for the two functions is that ContainsObject does not seem to work if I pass a Collection that has Longs pairs (the function always returns False.)
P.S.: The first function is a copy of the third answer from Test or check if sheet exists
You should use a Variant in the first function. You can assign an Object to a Variant, e.g. this won't error:
Sub Test()
Dim var As Variant
Dim obj As Object
Set obj = Application
var = Application
Debug.Print var
End Sub
But this will give a Type Mismatch compile error i.e. trying to assign a Long to an Object:
Sub Test()
Dim obj As Object
Dim lng As Long
lng = 3
Set obj = lng
End Sub
So, for a generic function (along the lines of your code) to check if a Collection key is valid, you can use:
Function HasKey(coll As Collection, strKey As String) As Boolean
Dim var As Variant
On Error Resume Next
var = coll(strKey)
HasKey = (Err.Number = 0)
Err.Clear
End Function
Test code:
Sub Test()
Dim coll1 As New Collection
coll1.Add Item:=Sheet1.Range("A1"), Key:="1"
coll1.Add Item:=Sheet1.Range("A2"), Key:="2"
Debug.Print HasKey(coll1, "1")
Dim coll2 As New Collection
coll2.Add Item:=1, Key:="1"
coll2.Add Item:=2, Key:="2"
Debug.Print HasKey(coll2, "1")
End Sub
There is a useful article on MSDN regarding this. The context is VB6 but relates to VBA.
Few typos as per comments have already been corrected during edit of your post.
In response to your question I would like to cover related aspects.
While Using keys in collections has mainly three advantages
- If the order changes your code will still access the correct item
- You can directly access the item without reading through the entire
collection
- It can make you code more readable.
*But at the same time there are mainly three issues with using keys in
collections
You cannot check if the key exists
You cannot change the key
You cannot retrieve the key
As per Pearsons article the Keys of a Collection are write-only -- there is no way to get a list of existing Keys of a Collection. Further going through quoted paragraph:-
Here, Coll is a Collection object in which we will store multiple
CFile objects. The CollKeys Collection is used to store the keys of
the CFile objects stored in the Coll Collection. We need this second
Collection because the Keys of a Collection are write-only -- there is
no way to get a list of existing Keys of a Collection. One of the
enhancements provided by CFiles is the ability to retrieve a list of
Keys for the Collection.
Custom Collection Classes
One way is to iterate over the members of the collection and see if there is match for what you are looking for and the other way is to catch the Item not in collection error and then set a flag to say the item does not exist. Opinions differ on these approaches whereas some people feel it is not a good method to catch error while other section feels that it will be significantly faster than iteration for any medium to large collection.
So if we go for a method to catch error then error number we get depends on exactly what caused the error. We need a code routine to check the error. In a simplest way it could be.
'c1 is the collection
For i = 1 To c1.Count
Debug.Print Err.Number, Err.Description
If Err.Number <> 0 Then Err.Clear
Next i
Error catching routines proposed by various professionals differ in the error number they consider important and include in their routine.Various commonly occurring error numbers associated with collection object are:-
Error 5 Invalid procedure call or argument.This error can also occur
if an attempt is made to call a procedure that isn't valid on the
current platform. For example, some procedures may only be valid for
Microsoft Windows, or for the Macintosh, and so on.
error 438 "object doesn't support this property or method An object
is a class instance. A class instance supports some properties
defined in that class type definition and does not support this one.
Error 457 This key is already associated with an element of this
collection.You specified a key for a collection member that already
identifies another member of the collection. Choose a different key
for this member.
Error 91 Object variable or With block variable not set.There are two
steps to creating an object variable. First you must declare the
object variable. Then you must assign a valid reference to the object
variable using the Set statement. You attempted to use an object
variable that isn't yet referencing a valid object.
Error 450 Wrong number of arguments or invalid property
assignment.The number of arguments in the call to the procedure
wasn't the same as the number of required arguments expected by the
procedure.If you tried to assign a value to a read-only property,
Among the above errors error number 438 has been considered important and the other one is 5. I am incorporating a Function routine in my sample testing program which was posted by Mark Nold 7 years back in 2008 vide SO question Determining whether an object is a member of a collection in VBA with due credit to him.
Some errors like error 457 won't be allowed at the time of program test run. I tried to populated with duplicate keys data, it gave the error at the time of program testing itself as shown in the snapshot.
After removing it is showing correct output as shown in the snap shot.
It may not be possible to get the list of keys of a collection with a vanilla collection without storing the key values in an independent array. The easiest alternative to do this is to add a reference to the Microsoft Scripting Runtime & use a more capable Dictionary instead.
I have included this approach to get the list of keys in my program.
While populating Collection it is to be ensured that the key is the second parameter and must be a unique string.
Full code of my program is.
Sub Generic_key_check()
Dim arr As Variant
Dim c1 As New Collection
Dim dic As Object
With Application
.ScreenUpdating = False
End With
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
'Populate the collection
c1.Add "sheet1", "sheet1"
c1.Add "sheet2", "sheet2"
c1.Add "sheet3", "sheet3"
c1.Add "sheet4", "sheet4"
c1.Add "sheet5", "sheet5"
c1.Add 2014001, "Long1"
c1.Add 2015001, "Long2"
c1.Add 2016001, "Long3"
c1.Add 2015002, "Long4"
c1.Add 2016002, "Long5"
'Populate the dictionary
dic.Add "sheet1", "sheet1"
dic.Add "sheet2", "sheet2"
dic.Add "sheet3", "sheet3"
dic.Add "sheet4", "sheet4"
dic.Add "sheet5", "sheet5"
dic.Add "Long1", 2014001
dic.Add "Long2", 2015001
dic.Add "Long3", 2016001
dic.Add "Long4", 2015002
dic.Add "Long5", 2016002
' Get a list of key items by Dictionary Method
Dim N As Variant
For Each N In dic.Keys
Debug.Print "Key: " & N, "Value: " & dic.item(N)
Next
'Test for two types of data whether key exists or not.
If InCollection(c1, "Long1") Then
'If Exists("Long1", c1) Then
Debug.Print "Good"
Else
' If there is error then print out the error number and its description.
Debug.Print Err.Number, Err.Description
Debug.Print "Not Good"
End If
If InCollection(c1, "sheet2") Then
Debug.Print "Good"
Else
Debug.Print Err.Number, Err.Description
Debug.Print "Not Good"
End If
'Checking whether desired key has populated correctly
Debug.Print c1("Sheet1")
Debug.Print c1("Long3")
'Listing out collection items to check theyexist in the collection.
For i = 1 To c1.Count
Debug.Print c1.item(i)
Next i
With Application
.ScreenUpdating = True
End With
Set c1 = Nothing
End Sub
Public Function InCollection(col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.Clear
On Error Resume Next
var = col.item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function
Final output as per program as shown in the Immediate window has been shown in the Snapshot.
Apostle is almost correct with their answer. Robin's answer will not work with generic objects, but will work as written because Excel's Range object will return the cell's value. I love Apostle's use of IsObject (mostly because ths is what I had figured out as well). The code is a little over-complicated though.
If the key exists in the collection IsObject will set the variant to True or False, otherwise an error will be ignored leaving the variant empty.
Function HasKey(col As Collection, Key As String) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(col.Item(Key))
HasKey = Not IsEmpty(v)
End Function
I want to point out that if you want to make PaulE's function a little more flexible, you can change the string parameter to a Variant, which means that you can now also use it to check either for an item key or for an item number, which is handy. Variants are a little slower if you're going to be checking a lot of collections, but for most purposes the two functions will act similarly.
Function HasItem(col As Collection, ItemKeyOrNum As Variant) As Boolean
Dim v As Variant
On Error Resume Next
v = IsObject(col.Item(ItemKeyOrNum))
HasItem = Not IsEmpty(v)
End Function
The accepted answer here is wrong (which is the case for quite a few other questions I have noticed as well, so watch out, and read all the answers). Apostle and PaulE collaborated there for the most correct answer to the specific question that was asked. I tried to use the accepted answer, but it didn't work.
The question clearly states, "Is there a way to check if a key is contained in the Collection that works for types as well as objects?"
The accepted answer DOES NOT work for objects. PaulE's answer is the final, and correct answer. I am just adding a little bit of nuance here to make the function more one-size-fits-all.
Short variant in one string:
Function keyExists(coll As Collection, key As String) As Boolean
On Error Resume Next: keyExists = IsObject(coll(key)) Or True
End Function
First, keyExists = false. Error trapper set to ignore errors. If expression (always TRUE) was calculated without errors (element with key exists), keyExists was TRUE.
Usage (with various types of values in collection):
Sub testExist()
Dim coll As New Collection
coll.Add New Collection, "1"
coll.Add Array(1, 1), "3"
coll.Add 1, "5"
coll.Add "1111", "9"
For i = 1 To 10
Debug.Print "key " & i & " is " & IIf(keyExists(coll, CStr(i)), "Exists", "Absent")
Next
End Sub
The method from Robin will fail if the Collection contains objects rather than primitive types because they need to be assigned using Set and otherwise generate an error that will result in the method returning False. Here is a small adjustment:
'Test if a key is available in a collection
Public Function HasKey(coll As Collection, strKey As String) As Boolean
On Error GoTo IsMissingError
Dim val As Variant
' val = coll(strKey)
HasKey = IsObject(coll(strKey))
HasKey = True
On Error GoTo 0
Exit Function
IsMissingError:
HasKey = False
On Error GoTo 0
End Function
I am building an array in VBA for Powerpoint.
The sub sweeps through all shapes in each slide in the presentation, and I want to store into the array:
The property (as string or object)
The value of that property.
I will then load this array into a list box.
When the user clicks on the selected item in the list box I want the property to be set with the value.
In code it would be something like this:
Dim s_MyProperty as string
Dim s_Value as string
'Remember the variables
s_MyProperty = ".PageSetup.SlideHeight"
s_Value = ActivePresentation.PageSetup.SlideHeight
' This is the part I need help with
' Apply the property
Dim o_Object as object ' or something similar
o_Object = ActivePresentation
o_Object & s_MyProperty = s_Value
The code would be similar in Excel.
Any ideas?
check out the CallByName function... its an oldie but a goodie.
CallbyName o_Object, s_MyProperty, VbLet, s_Value