I have the following declared:
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal X0_Y1 As Long) As Long
It grabs the monitor resolution.
So that in the future I remember to type 0 for x resolution and 1 for y resolution I have named the argument variable to illustrate that (X0_Y1). (So user can use ctrl+a or ctrl+Shift+a when entering the function to display its arguments)
But what I really want is to type "x" to get the x res and "y" for y res (i.e. =GetSystemMetrics("x") gives the x resolution). Is there a way to do this within the function decleration? Like (ByVal iif(X0_Y1 ="x",0,1) As Long) to specify what to do with the input.
I'd rather not just do this:
Function GetRes(letter As String) As Long
Dim i As Long
i = IIf(letter = "x", 0, 1)
GetRes = GetSystemMetrics(i)
End Function
As it involves creating a whole new function which is more unweildy than just using the base one.
Perhaps there's some way to specify x/y as constants so that if the user enters them they are read as numbers not strings? Another nice option would be to get the input options displayed like the Cell function does. (Similar to this question, but not the same)
You can use an Enum Statement for this.
Declare an enum and your function like that
Public Enum MetricsType
xMetrics = 0
yMetrics = 1
End Enum
Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal xy As MetricsType) As Long
and you can use it like this
Dim x As Long, y As Long
x = GetSystemMetrics(xMetrics)
y = GetSystemMetrics(yMetrics)
This will also enable AutoComplete in the VBA editor.
To enhance the usability within the worksheet you can register/unregister your function as a UDF (user defined function). After registering you can select your function from the function menu and you see the comments within this dialog.
Sub RegisterUDF()
Dim s As String
s = "Some description here" & vbLf _
& "GetSystemMetrics(<Metrics>)"
Application.MacroOptions Macro:="GetSystemMetrics", Description:=s, Category:="My Category"
End Sub
Sub UnregisterUDF()
Application.MacroOptions Macro:="GetSystemMetrics", Description:=Empty, Category:=Empty
End Sub
To get the enum working within the worksheet there is only workaround possible. Therefore you add a named range referring to =0 or =1 like below:
Sub RegisterEnum()
ActiveWorkbook.Names.Add Name:="xMetrics", RefersToR1C1:="=0"
ActiveWorkbook.Names.Add Name:="yMetrics", RefersToR1C1:="=1"
'NOTE: don't use x or y as names here as these refer to the column names.
'That's why I used xMetrics instead.
End Sub
Then you are able to use the function in your worksheet like =GetSystemMetrics(xMetrics).
Creating the exactly same behavior like the built-in functions isn't possible as far as I know.
Related
I am trying use VBA to determine the user preference for the measurement unit in PowerPoint, however, I can't find the correct method. Do you know a way to determine if the unit setting is in inches, cm, pt?
I had this need too; with Word or Excel is easy, because Word.Application.Options.MeasurementUnit or Excel.Application.MeasurementUnit returns it; but for other Office Apps you have to grab it from a registry key, if your project has no Word or Excel reference, of course.
I have in one module:
Option Explicit
Public Const KeyInternationalMeasurementUnits As String = "HKEY_CURRENT_USER\Control Panel\International\iMeasure"
Enum eMeasure
Metrics = 0
Imperial = 1
End Enum
Function eMeasure_ToEnum(str As String) As eMeasure
Select Case str
Case "Metrics": eMeasure_ToEnum = Metrics
Case "Imperial": eMeasure_ToEnum = Imperial
End Select
End Function
Function eMeasure_ToString(value As eMeasure) As String
Select Case value
Case Metrics: eMeasure_ToString = "Metrics"
Case Imperial: eMeasure_ToString = "Imperial"
End Select
End Function
Function RegKeyRead(ByVal ReadedKey As String) As String
Dim thisWS As Object
Set thisWS = CreateObject("WScript.Shell")
RegKeyRead = thisWS.RegRead(ReadedKey)
Set thisWS = Nothing
End Function
Function RegKeyExists(ByVal RegKey As String) As Boolean
Dim thisWS As Object
On Error GoTo ErrorHandler
Set thisWS = CreateObject("WScript.Shell")
thisWS.RegRead RegKey
RegKeyExists = True
GoTo ExitFunction
ExitFunction:
Set thisWS = Nothing
Exit Function
ErrorHandler:
RegKeyExists = False
GoTo ExitFunction
End Function
And I call it whenever I need to:
Function WhichInternationalMeasurementUnits() As String
If RegKeyExists(KeyInternationalMeasurementUnits) Then
WhichInternationalMeasurementUnits = eMeasure_ToString(CInt(RegKeyRead(KeyInternationalMeasurementUnits)))
End If
End Function
You can adapt too an IsWord or IsExcel precondition test like this one that I used to grab which decimal sign is on regional settings.
If you're on Windows, there is no setting for preferred measurement units. PPT picks up the units, metric or imperial, from your Windows settings.
If it's important to know what units the user is seeing, you'd need to query the Win API.
If your code needs to use coordinates, the setting the user sees is not relevant; your code will use points (72 to the inch).
Did a bit of digging in a couple of Dan Appleman's old books and cobbled up this API call to determine whether the system is set to US or Metric. If I pass it 1033 (US English), it returns 1 until I go into Control Panel and set the system for metric; then it returns 0. But with the system set to US, the function returns 0 if I pass it the locale code for e.g. Dutch.
Fair warning: I'm strictly a cut/paste/play 'til it stops crashing API programmer. Nearly incompetent at it. Take it all with a grain of salt, eh?
Option Explicit
Declare Function GetLocaleInfo& Lib "kernel32" Alias "GetLocaleInfoA" (ByVal _
Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData _
As Long)
Function WindowsUSorMetric() As Long
' Returns 1 for U.S. or 0 for Metric
' NOTE: Needs modification before it'll work with 64-bit apps
' Assumes USEnglish
Dim Locale As Long
Dim LCType As Long
Dim lpLCData As String
Dim cchData As Long
' 1033 is the languageID for US English
' Use the Object Browser in the VBA IDE, look up msolanguageid for others
Locale = 1033
LCType = &HD
lpLCData = String$(255, 0)
cchData = 255
Call GetLocaleInfo(Locale, LCType, lpLCData, cchData)
WindowsUSorMetric = CLng(Left$(lpLCData, InStr(lpLCData, Chr$(0)) - 1))
End Function
Sub TestMe()
MsgBox WindowsUSorMetric
End Sub
After August 2019 Windows update there is a problem using the array() function in VBA.
Is there any other way to create an empty array in VBA for the purpose "Using multi value combobox on a form"?
The following statement to clear/delete all the selections:
me.cmbMultivalue=Array()
The array returned by Array() is not just an uninitialized array. It's an initialized array with a lower bound of 0 and an upper bound of -1, thus containing 0 elements. This is distinct from normal, uninitialized arrays, which don't have a lower and upper bound.
You can roll your own array function (which I often do for non-variant arrays).
For a variant array, it's really easy. Just take an input ParamArray, and assign that to a variant array:
Public Function altArray(ParamArray args() As Variant) As Variant()
altArray = args
End Function
Then, you can use altArray() to get your special 0-element array.
However, I'm not sure this is also bugged for that specific version of Access. If it is, we can always create a 0-element array using WinAPI (slightly adapted version of this answer):
Public Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Public Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
pSomething As LongPtr
End Type
Public Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Public Declare PtrSafe Sub VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any)
Public Declare PtrSafe Sub SafeArrayDestroy Lib "OleAut32.dll" (ByVal psa As LongPtr)
Public Function CreateZeroLengthArray() As Variant
Dim bounds As SAFEARRAYBOUND 'Defaults to lower bound 0, 0 items
Dim NewArrayPointer As LongPtr 'Pointer to hold unmanaged variant array
NewArrayPointer = SafeArrayCreate(vbVariant, 1, bounds)
Dim tagVar As tagVariant 'Unmanaged variant we can manually manipulate
tagVar.vt = vbArray + vbVariant 'Holds a variant array
tagVar.pSomething = NewArrayPointer 'Make variant point to the new variant array
VariantCopy CreateZeroLengthArray, ByVal tagVar 'Copy unmanaged variant to managed return variable
SafeArrayDestroy NewArrayPointer 'Destroy the unmanaged SafeArray, leaving the managed one
End Function
When you declare a new array, it is still an empty array.
i.e. Dim x() As Variant
(1) As you mention in your question, your goal is to clear combobox values by assigning an empty array to it, it seems like this would work:
Dim EmptyArray() As Variant
Me.cmbMultivalue = EmptyArray
(2) Or if that doesn't work, assuming that Me.cmbMultivalue behaves like a regular array, the following would work:
Erase Me.cmbMultivalue
EDIT:
(3) Another possible workaround similar to (1) would be to create a non-empty array and then erase it as such:
Dim x() As Variant
x = Array(1)
Erase x
You could then use x as an empty array.
If all that fails and, as you mentioned, assigning the value Null or vbEmpty didn't work, it seems like your only options would be to revert the problematic Windows update or hope Microsoft can fix this quickly.
Alternative to clear all values from a multi-value field is with SQL. Example:
CurrentDb.Execute "DELETE Table1.Test.Value FROM Table1 WHERE ID = 1"
I have two private functions in two different modules. These two functions should share a common variable. How should I go about programming this?
The current code is this:
Private function TestFunction1 (ByVal traffic as string) As Boolean
'snippet from the code
dim amount as string
amount = inputbox("Fill in amount")
end function
Private Function TestFunction2 (ByVal layout as string) as Boolean
'snippet from the code
dim result as string
result = "the amount is: " & amount
end function
I know this is not a correct function but it's just a part of the code. I cannot share the entire code because of business regulations.
How should I go about passing the amount to the other function in another module?
Thanks
Sure, that's doable by declaring the amount variable as Public:
Public amount As Long 'not sure why you declared it as a string, as it seems to be a number
Private function TestFunction1 (ByVal traffic as string) As Boolean
'snippet from the code
amount = inputbox("Fill in amount")
End Function
I generally use VBA but have been reading up on programming techniques in The C# Programming Yellow Book which, obviously, is more specific to C#. Anyway, it mentions a technique of passing parameters using the Out keyword.
I already know that VBA supports byVal and byRef and am fairly certain there is no direct equivalent for Out. Passing parameters using Out is subtly different to passing parameters by Ref.
This Answer https://stackoverflow.com/a/388781/3451115 seems to give a good explanation of the difference between Out & Ref.
The Ref modifier means that:
The value is already set and
The method can read and modify it.
The Out modifier means that:
The Value isn't set and can't be read by the method until it is set.
The method must set it before returning.
In the code base that I've inherited there are several places where values are assigned to variables using methods that accept parameters byRef. It seems to me that while passing byRef does the job, passing by Out would be safer... So (and here is the question) is there a way of safely / reliably replicating Out in VBA?
In my first iteration (original question) I imagined that the code would have a pattern like:
Sub byOutExample(byRef foo As String)
' Check before running code:
' foo must = vbNullString
If foo <> vbNullString then Err.Raise(someError)
' Do Something to assign foo
foo = someString
' Check before exiting:
' foo must <> vbNullString
If foo = vbNullString then Err.Raise(someError)
End Sub
Other considerations: is it worth doing, is there a better way, what could go wrong?
Edit: I noticed in the comments for the above definition of Ref vs Out that the passed parameter need not be null, nothing, empty etc. it can be preassigned - the main criteria seems that it is re-assigned.
In light of #ThunderFrame's answer below and the comment that a parameter passed by Out can be pre-assigned (and used), perhaps the following is a better approach:
Sub byOutExample(ByRef foo As String)
Dim barTemp As String
barTemp = foo
' Do Something to assign a new value to foo (via barTemp)
barTemp = someString
' Must assign new variable
foo = barTemp
End Sub
In which case would it be true to say that, as long as foo only appears in the 2 locations shown above, the above code is an accurate way to replicate passing a parameter by Out in VBA?
The answer is unequivocally 'no' you cannot replicate the C# out parameter modifier in VBA. From https://learn.microsoft.com/en-us/dotnet/csharp/language-reference/keywords/out-parameter-modifier:
Variables passed as out arguments do not have to be initialized before
being passed in a method call. However, the called method is required
to assign a value before the method returns.
These aspects simply don't exist in VBA. All variables in VBA are initialised with default values, ie the concept of an unitialised variable does not exist in VBA, so point 1 isn't possible; and the compiler cannot object if a specified parameter has not had a value assigned within the procedure, so point 2 isn't possible either.
Even the coding patterns in your example would rely on the Do Something to assign foo not to resolve to the relevant data type's default value (which is obviously not the same as being unitialised). The following, for example, would wrongly throw an error:
Public Sub Main()
Dim income As Long, costs As Long
Dim result As Long
income = 1000
costs = 500
ProcessSpend income, costs, result
End Sub
Private Sub ProcessSpend(income As Long, costs As Long, ByRef outValue As Long)
Const TAX_RATE As Long = 2
Dim netCosts As Long
Dim vbDefaultValue As Long
netCosts = costs * TAX_RATE
outValue = income - netCosts
If outValue = vbDefaultValue Then Err.Raise 5, , "Unassigned value"
End Sub
So we're really left with the question of is there a way of getting close to the characteristics of out in VBA?
Unitialised variables: the closest I can think of are a Variant or Object type which by default initialise to Empty and Nothing respectively.
Assign value within the procedure: the simplest way would be to test if the address of the assigning procedure matches your desired procedure address.
It's all leaning towards a helper class:
Option Explicit
Private mNumber As Long
Private mTargetProc As LongPtr
Private mAssignedInProc As Boolean
Public Sub SetTargetProc(targetProc As LongPtr)
mTargetProc = targetProc
End Sub
Public Sub SetNumber(currentProc As LongPtr, val As Long)
mAssignedInProc = (currentProc = mTargetProc)
mNumber = val
End Sub
Public Property Get Number() As Long
If mAssignedInProc Then
Number = mNumber
Else
Err.Raise 5, , "Unassigned value"
End If
End Property
And then the previous example would look like this:
Public Sub Main()
Dim income As Long, costs As Long
Dim result As clsOut
income = 1000
costs = 500
ProcessSpend income, costs, result
Debug.Print result.Number
End Sub
Private Sub ProcessSpend(income As Long, costs As Long, outValue As clsOut)
Const TAX_RATE As Long = 2
Dim netCosts As Long
If outValue Is Nothing Then
Set outValue = New clsOut
End If
outValue.SetTargetProc AddressOf ProcessSpend
netCosts = costs * TAX_RATE
outValue.SetNumber AddressOf ProcessSpend, income - netCosts
End Sub
But that's all getting very onerous... and it really feels as if we are trying to force another language's syntax onto VBA. Stepping back a little from the out characteristics and developing in a syntax for which VBA was designed, then a function which returns a Variant seems the most obvious way to go. You could test if you forgot to set the 'out' value by checking if the function returns an Empty variant (which suits point 1 and 2 of the out characteristics):
Public Sub Main()
Dim income As Long, costs As Long
Dim result As Variant
income = 1000
costs = 500
result = ProcessedSpend(income, costs)
If IsEmpty(result) Then Err.Raise 5, , "Unassigned value"
End Sub
Private Function ProcessedSpend(income As Long, costs As Long) As Variant
Const TAX_RATE As Long = 2
Dim netCosts As Long
netCosts = costs * TAX_RATE
'Comment out the line below to throw the unassigned error
ProcessedSpend = income - netCosts
End Function
And if you wanted the option of passing in a pre-assigned value, then could just define an optional argument as a parameter to the function.
You can pseudo enforce an out type parameter in VBA by passing it in ByRef, and then checking that it is Nothing (or the default value for a value type) before continuing, much as you have done with the String in your example.
I wouldn't impose the exit condition - sometimes an empty string is a perfectly valid return value, as is a Nothing reference.
Dear all and thank you in advance.
Problem:
Instead of having two dropdown boxes for list A and list B. I would like to combine the two lists (they do relate) and display them to the user as 1 list. Then split it back into two so that I can store the relevant info.
List 1
Machines
1. Machine x
2. Machine y
List 2 Test Types
1. Test Type ab
2. Test Type ac
3. Text Type ad.
so Machine 1 can do test type ab, and ac. Machine 2 can do test type ac and ad.
It will be stored under 3 different tables (not really but just think that it will). 2 tables will contain the list and the third will contain the relationship between the two lists. I.e. which items from list 1 pair up with which items from list 2 etc.
To the user it would be displayed as follows
Machine X - ab
Machine x - ac
Machine y - ac
Machine y - ad
The user would then select 1 from the list and I would then decode the two items selected.
My thought so far is to use bits (and/or) as required.
There will be three functions
public function joinAB(a as long, b as long) as long
end function
Public function getA(ab as long) as long
end function
public function getB(ab as long)as long
end function
So just to clarify this is not to join text together, but to join/split ID's of the individual items in these two lists.
Anyone else have any other ideas. This will be done in a legacy system (VB6) which I have inherited. My VB6 coding skills are above average.
Thank you for any help/code snippets provided or general advice.
If you need more information please let me know.
Assuming a and b are numeric variables as your 3 functions suggest I would use the .ItemData() property of the items in the combined list just like Mark and use division and remained to obtain the separate parts:
Public Function joinAB(a As Long, b As Long) As Long
joinAB = a * 100 + b
End Function
Public Function getA(ab As Long) As Long
getA = ab \ 100
End Function
Public Function getB(ab As Long) As Long
getB = ab Mod 100
End Function
this assumes that b will never be higher than 100, and that neither a or b will be negative
If a and b are string variables then i would show the joined strings as the text int he combobox and split the selected text to get the seprate parts
Public Function joinAB(a As String, b As String) As String
joinAB = a & " - " & b
End Function
Public Function getA(ab As String) As String
getA = Left$(ab, InStr(ab, " - ") - 1)
End Function
Public Function getB(ab As String) As String
getB = Mid$(ab, InStr(ab, " - ") + 3)
End Function
make use of the 3rd table in which the relation is mapped , if the relation have a unique id then you can make use of that to join/split the list....
or provide us with the table structure and data...
There are probably a few solutions to this.
The simplest is that you create a unique 32-bit integer field on your join table. This can then be embedded in the ItemData property of the VB6 ListBox.
A couple of helper functions for this are:
Private Sub AddListBoxItem(ByRef lst as ListBox, ByVal in_nKey As Long, ByRef in_sDisplay As String)
With lst
.AddItem in_sDisplay
.ItemData(.NewIndex) = in_nKey
End With
End Sub
Private Function GetSelectedListBoxKey(ByRef in_lst As ListBox) As Long
With in_lst
GetSelectedListBoxKey = .ItemData(.ListIndex)
End With
End Function
As for implementing your functions, I would simply use two collection.
m_col_A_B_to_AB would be keyed by A & "_" & B to return AB. m_col_AB_to_A_B would be keyed to AB to return A and B.
Helper functions would be:
Private Sub AddRow(ByVal in_nA As Long, ByVal in_nB As Long, ByVal in_nAB As Long)
Dim an(0 To 1) As Long
an(0) = in_nA
an(1) = in_nB
m_col_A_B_to_AB.Add an(), CStr(in_nAB)
m_col_AB_to_A_B.Add in_nAB, CStr(in_nA) & "_" & CStr(in_nB)
End Sub
Private Sub Get_A_B(ByVal in_nAB As Long, ByRef out_nA As Long, ByRef out_nB As Long)
Dim vTmp As Variant
vTmp = m_col_A_B_to_AB.Item(CStr(in_nAB))
out_nA = vTmp(0)
out_nB = vTmp(1)
End Sub
Private Function GetA(ByVal in_nAB As Long) As Long
Get_A_B in_nAB, GetA, 0&
End Function
Private Function GetB(ByVal in_nAB As Long) As Long
Get_A_B in_nAB, 0&, GetB
End Function
Private Function JoinAB(ByVal in_nA As Long, ByVal in_nB As Long) As Long
JoinAB = m_col_AB_to_A_B.Item(CStr(in_nA) & "_" & CStr(in_nB))
End Function