This excel-names project is contained in VBA , and it might offer some insights on the validity of various names in Excel and VBA. Unfortunately, it cannot fully guarantee validity here :
Names_IsValidName(sNameToTest As String) As Boolean
Check if the name is valid:
true
: Excel name is probably valid
false
: Excel name is for sure not valid
Additionally, the XLParser project in C# specifies here many of the special operators and characters in Excel formulae.
However, I am still trying to determine exactly how these might apply to my solution, which must be contained in VBA.
I am writing in VBA a lightweight parser for Excel formulae, which assumes that any input is syntactically valid (as validated by Excel). My goal is to properly pinpoint an entire function call within a formula.
For this, I need a function FindValidName()
. This function accepts a String
ending at the open parenthesis ( (
) of a function call, and searches backward to locate the beginning of the valid formula name; or it returns -1
if no such name is found.
What are the syntactic criteria for a valid function name, accessible in an Excel formula ? This does not encompass every function like VBA.Mid()
accessible in VBA , since those are not accessible in Excel itself. Neither does it encompass user-defined functions (UDFs) in VBA, which are accessible in Excel and have their nomenclature defined here .
More generally, how might one algorithmize in VBA a backwards search by FindValidName()
from the end of the name? Mind you, this must encompass ∪, where: is the set of names for all native functions that could ever be accessed in an Excel formula; and is the set of (syntactically valid) names for all UDFs that could ever be defined in VBA and accessed in Excel.
We can assume that the formula is syntactically valid . So if we encounter (searching "backwards" from right to left) a character like +
that is illegal (?) for a function name, we know that this is not simply a typo. Rather, we know that any name must start to the right of ("before") that +
= A1+SUM(B1,C1)
|<-|
and if there are no characters "before" the +
, then the (
is simply a grouping operation:
= A1+(B1*C1)
|
Given the below formula extracted as a String
via .Formula
, I can already pinpoint where a call begins.
= A1 & CONCAT(B1, C1)
^ ^
14 21
I have already generalized this to FindFormulaCall(fml, [n])
, which can locate the n
th call (here the 2
nd) in an arbitrarily complex formula (below).
= SUM(ABS(A1:A5)) + ABS(My_Table[@[Column Name With Punctuation: ", '@, (, ), '[, and '].]]) + ABS(B1)
^ ^
24 92
Now I need FindValidName("= A1 & CONCAT")
to "search backwards" until the start of "CONCAT"
= A1 & CONCAT(B1, C1)
|<----|
6
and return the Long
number of characters (measured from the end) at which that start occurs: here 6
. Alternatively, it should return -1
if no valid name is encountered.
For FindValidName("= A1 & CONCAT")
the result should be 6
:
= A1 & CONCAT(B1, C1)
|<----|
6
For FindValidName("= A1+SUM(B1)+ABS")
the result should be 3
:
= A1+SUM(B1)+ABS(C1)
|<-|
3
For FindValidName("= A1*SUM(B1)*")
the result should be -1
for no valid name:
= A1*SUM(B1)*(C1 + D1)
|
I don't know if the two code samples below are of any use to you. I wrote them some time ago for a teacher friend who was trying to show how Excel worked.
The first parses the formula of a cell into their individual formulas and shows how each formula resolves to the next.
The second gets a list of every formula available in a particular workbook.
For the first, you'll need two helper classes, called clsParenthetical
Option Explicit
Public IsFormula As Boolean
Public FormulaName As String
Public Expression As String
Public Result As Variant
Public Index As Long
and clsParsedFormula
Option Explicit
Public KeyText As String
Public Perentheticals As Collection
Then, the main class, called clsFormulaHelper , is this:
Option Explicit
'===========================================================================
'DECLARATIONS
'===========================================================================
'---------------------------------------------------------------------------
'region PRIVATE TYPES
Private Type Points
IsValid As Boolean
OpenAt As Long
CloseAt As Long
End Type
Private Type ExprKVP
Index As Long
Value As String
End Type
'end region PRIVATE TYPES
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'region PRIVATE CONSTANTS
Private Const ARITHMETIC_OPR_TAG As String = "Arith"
Private Const COMPARISON_OPR_TAG As String = "Comp"
Private Const TEXT_OPR_TAG As String = "Text"
Private Const REFERENCE_OPR_TAG As String = "Ref"
'end region PRIVATE CONSTANTS
'---------------------------------------------------------------------------
'---------------------------------------------------------------------------
'region MODULE-LEVEL VARIABLES
Private mOperators As Collection
Private mRngOperators As Variant
'end region MODULE-LEVEL VARIABLES
'---------------------------------------------------------------------------
'===========================================================================
'METHODS
'===========================================================================
Public Function ParseFormula(rng As Range) As clsParsedFormula
Const ARRAY_INC As Long = 100
Dim pts As Points
Dim quotes() As ExprKVP
Dim parenthetical As clsParenthetical, p As clsParenthetical
Dim ex As String
Dim c As Long, i As Long
Dim v As Variant
'Validation check.
If rng Is Nothing Then Exit Function
If rng.Cells.Count > 1 Then Exit Function
If Not rng.HasFormula Then Exit Function
Set ParseFormula = New clsParsedFormula
With ParseFormula
.KeyText = rng.Formula
'Remove any strings from the formula
'in case target characters (eg '(' or ')')
'are contained within the strings.
ReDim quotes(ARRAY_INC)
c = -1
Do
pts = FindQuotation(.KeyText)
If pts.IsValid Then
c = c + 1
'Resize the array if limit is reached.
If c > UBound(quotes) Then
ReDim Preserve quotes(UBound(quotes) + ARRAY_INC)
End If
'Populate the quote item with the quotation
'and index value.
With quotes(c)
.Value = Mid(ParseFormula.KeyText, _
pts.OpenAt, _
pts.CloseAt - pts.OpenAt + 1)
.Index = c
End With
'Replace the quotation with the key.
.KeyText = Left(.KeyText, pts.OpenAt - 1) & _
StringKeyBuilder(c) & _
Right(.KeyText, Len(.KeyText) - pts.CloseAt)
End If
'Coninue until no further quotations found.
Loop Until Not pts.IsValid
'Reduce array to correct size.
If c = -1 Then
Erase quotes
Else
ReDim Preserve quotes(c)
End If
Set .Perentheticals = New Collection
c = -1
Do
pts = FindDeepestOpenAndClose(.KeyText)
If pts.IsValid Then
c = c + 1
ex = ExtractBackToOperator(pts.OpenAt, .KeyText)
'Populate the parenthesis item.
Set parenthetical = New clsParenthetical
With parenthetical
.Index = c
.IsFormula = Len(ex) > 0
If .IsFormula Then
.FormulaName = ex
pts.OpenAt = pts.OpenAt - Len(ex)
End If
.Expression = Mid(ParseFormula.KeyText, _
pts.OpenAt, _
pts.CloseAt - pts.OpenAt + 1)
End With
.Perentheticals.Add parenthetical, CStr(c)
'Replace the parenthesis with the key.
.KeyText = Left(.KeyText, pts.OpenAt - 1) & _
FormulaKeyBuilder(c) & _
Right(.KeyText, Len(.KeyText) - pts.CloseAt)
End If
Loop Until Not pts.IsValid
'Calculate the results.
For Each parenthetical In .Perentheticals
ex = parenthetical.Expression
pts.OpenAt = 1
pts.CloseAt = 0
'Replace the string expressions.
Do While True
pts.OpenAt = InStr(pts.OpenAt, parenthetical.Expression, "{str")
If pts.OpenAt = 0 Then Exit Do
pts.CloseAt = InStr(pts.OpenAt, parenthetical.Expression, "}")
If pts.CloseAt = 0 Then Exit Do
i = ExtractIndexFromStringExpression(parenthetical.Expression, pts)
If i >= 0 And i <= UBound(quotes) Then
ex = Replace(ex, "{str" & i & "}", quotes(i).Value)
End If
pts.OpenAt = pts.CloseAt + 1
Loop
'Replace the function expressions.
pts.OpenAt = 1
pts.CloseAt = 0
Do While True
pts.OpenAt = InStr(pts.OpenAt, parenthetical.Expression, "{f")
If pts.OpenAt = 0 Then Exit Do
pts.CloseAt = InStr(pts.OpenAt, parenthetical.Expression, "}")
If pts.CloseAt = 0 Then Exit Do
i = ExtractIndexFromFunctionExpression(parenthetical.Expression, pts)
If i > -1 Then
Set p = .Perentheticals(CStr(i))
If Not p Is Nothing Then
ex = Replace(ex, "{f" & i & "}", p.Result)
End If
End If
pts.OpenAt = pts.CloseAt + 1
Loop
parenthetical.Expression = ex
v = Evaluate(ex)
If VarType(v) = vbString Then
v = chr(34) & v & chr(34)
End If
parenthetical.Result = v
Next
End With
End Function
'===========================================================================
'PRIVATE HELPER FUNCTIONS
'===========================================================================
'---------------------------------------------------------------------------
'Purpose: Converts a Long to a string key in the format {f}.
'@i: Long to be turned into formula key.
'---------------------------------------------------------------------------
Private Function FormulaKeyBuilder(i As Long) As String
FormulaKeyBuilder = "{f" & i & "}"
End Function
'---------------------------------------------------------------------------
'Purpose: Converts a Long to a string key in the format {strn}.
'@i: Long to be turned into string key.
'---------------------------------------------------------------------------
Private Function StringKeyBuilder(i As Long) As String
StringKeyBuilder = "{str" & i & "}"
End Function
'---------------------------------------------------------------------------
'Purpose: Finds position of open and close inverted commas.
'@txt: string to be searched.
'Note 1: finds closest quotation to start of string.
'Returns: Points type. If unsuccessful IsValid = False.
'---------------------------------------------------------------------------
Private Function FindQuotation(txt As String) As Points
Dim openPt As Long, closePt As Long, tmp As Long
On Error GoTo EH
openPt = InStr(txt, """")
If openPt = 0 Then GoTo EH
tmp = openPt
Do While True
tmp = InStr(tmp + 1, txt, """")
If tmp = 0 Then GoTo EH
If tmp = Len(txt) Then closePt = tmp: Exit Do
If Mid(txt, tmp + 1, 1) <> """" Then closePt = tmp: Exit Do
tmp = tmp + 1
Loop
With FindQuotation
.IsValid = True
.OpenAt = openPt
.CloseAt = closePt
End With
Exit Function
EH:
FindQuotation.IsValid = False
End Function
'---------------------------------------------------------------------------
'Purpose: Finds position of open and close parenthensis at deepest level.
'@txt: string to be searched.
'Note 1: finds deepest Expr closest to start of string.
'Returns: Points type. If unsuccessful IsValid = False.
'---------------------------------------------------------------------------
Private Function FindDeepestOpenAndClose(txt As String) As Points
Dim openPt As Long, closePt As Long
On Error GoTo EH
closePt = InStr(txt, ")")
If closePt = 0 Then GoTo EH
openPt = InStrRev(txt, "(", closePt)
If openPt = 0 Then GoTo EH
With FindDeepestOpenAndClose
.IsValid = True
.OpenAt = openPt
.CloseAt = closePt
End With
Exit Function
EH:
FindDeepestOpenAndClose.IsValid = False
End Function
'---------------------------------------------------------------------------
'Purpose: Determines if char is any Excel operator.
'@char: Character to be evaluated.
'Returns: True if successful.
'---------------------------------------------------------------------------
Private Function IsOperator(char As String, _
Optional arithOpr As Boolean = True, _
Optional compOpr As Boolean = True, _
Optional textOpr As Boolean = True, _
Optional refOpr As Boolean = True) As Boolean
Dim exists As Boolean
Dim opr As Collection
On Error Resume Next
If arithOpr Then
Set opr = mOperators(ARITHMETIC_OPR_TAG)
If Not opr Is Nothing Then
exists = opr(char)
If exists Then
IsOperator = True
Exit Function
End If
End If
End If
If compOpr Then
Set opr = mOperators(COMPARISON_OPR_TAG)
If Not opr Is Nothing Then
exists = opr(char)
If exists Then
IsOperator = True
Exit Function
End If
End If
End If
If textOpr Then
Set opr = mOperators(TEXT_OPR_TAG)
If Not opr Is Nothing Then
exists = opr(char)
If exists Then
IsOperator = True
Exit Function
End If
End If
End If
If refOpr Then
Set opr = mOperators(REFERENCE_OPR_TAG)
If Not opr Is Nothing Then
exists = opr(char)
If exists Then
IsOperator = True
Exit Function
End If
End If
End If
End Function
'---------------------------------------------------------------------------
'Purpose: Extracts string from a nominated position backwards as far as
' any operator or start of string.
'@pt: position in string to commence extraction.
'@str: string for extraction.
'Note 1: Target string length must be greater than 1.
'Returns: Extracted text or null string if no operator is found.
'---------------------------------------------------------------------------
Private Function ExtractBackToOperator(pt As Long, str As String) As String
Dim i As Long
Dim chr As String
If pt < 2 Then Exit Function
For i = pt - 1 To 1 Step -1
chr = Mid(str, i, 1)
If IsOperator(chr) Then
ExtractBackToOperator = Mid(str, i + 1, pt - (i + 1))
Exit Function
End If
Next
End Function
'---------------------------------------------------------------------------
'Purpose: Extracts index number from function expression.
'@expr: Target expression.
'@pts: start and end point of function.
'Returns: Index number or -1 of failed.
'---------------------------------------------------------------------------
Private Function ExtractIndexFromFunctionExpression(expr As String, pts As Points) As Long
On Error GoTo EH
ExtractIndexFromFunctionExpression = Mid(expr, pts.OpenAt + 2, pts.CloseAt - pts.OpenAt - 2)
Exit Function
EH:
ExtractIndexFromFunctionExpression = -1
End Function
'---------------------------------------------------------------------------
'Purpose: Extracts index number from string expression.
'@expr: Target expression.
'@pts: start and end point of function.
'Returns: Index number or -1 of failed.
'---------------------------------------------------------------------------
Private Function ExtractIndexFromStringExpression(expr As String, pts As Points) As Long
On Error GoTo EH
ExtractIndexFromStringExpression = Mid(expr, pts.OpenAt + 4, pts.CloseAt - pts.OpenAt - 4)
Exit Function
EH:
ExtractIndexFromStringExpression = -1
End Function
Private Sub Class_Initialize()
Dim opr As Collection
Set mOperators = New Collection
Set opr = New Collection
opr.Add True, "+"
opr.Add True, "-"
opr.Add True, "*"
opr.Add True, "/"
opr.Add True, "%"
opr.Add True, "^"
mOperators.Add opr, ARITHMETIC_OPR_TAG
Set opr = New Collection
opr.Add True, "="
opr.Add True, ">"
opr.Add True, "<"
mOperators.Add opr, COMPARISON_OPR_TAG
Set opr = New Collection
opr.Add True, "&"
mOperators.Add opr, TEXT_OPR_TAG
Set opr = New Collection
opr.Add True, ":"
opr.Add True, ","
opr.Add True, " "
mOperators.Add opr, REFERENCE_OPR_TAG
End Sub
You would call it in a module like this:
Dim helper As clsFormulaHelper
Dim parsedFormula As clsParsedFormula
Dim parenthetical As clsParenthetical
Set helper = New clsFormulaHelper
Set parsedFormula = helper.ParseFormula(Sheet1.Range("A4"))
Here are the outputs:
For formula: =IF(A1*(A1 + 'AB + CD',A2) = 3, SUM(A1,A2,'AB + CD',A3): IF(A1 = 2, AVERAGE(A1:A3),"c" & COUNT(A1:A3)))
Nested index: 0, Expr: (A1 + 'AB + CD',A2): Result: 3
Nested index: 1, Expr: SUM(A1,A2,'AB + CD',A3): Formula, SUM: Result: 6
Nested index: 2, Expr: AVERAGE(A1:A3), Formula: AVERAGE, Result: 2
Nested index: 3, Expr: COUNT(A1:A3), Formula: COUNT, Result: 3
Nested index: 4, Expr: IF(A1 = 2, 2,"c" & 3), Formula: IF, Result: "c3"
Nested index: 5, Expr: IF(A1*3 = 3, 6, "c3"), Formula: IF, Result: 6
The second code sample gets a list of all formulas available in the workbook. It will only work on 64-bit.
Option Explicit
'---------------------------------------------------------
'Hook APIs and Constants
'---------------------------------------------------------
Private Declare PtrSafe Function SetWinEventHook _
Lib "user32" _
(ByVal eventMin As Long, _
ByVal eventMax As Long, _
ByVal hmodWinEventProc As LongPtr, _
ByVal pfnWinEventProc As LongPtr, _
ByVal idProcess As Long, _
ByVal idThread As Long, _
ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function UnhookWinEvent _
Lib "user32" _
(ByVal hWinEventHook As LongPtr) As Long
Private Declare PtrSafe Function GetCurrentProcessId _
Lib "kernel32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId _
Lib "user32" _
(ByVal hWnd As LongPtr, _
lpdwProcessId As Long) As Long
Private Declare PtrSafe Function GetClassName _
Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Const EVENT_OBJECT_CREATE As Long = 32768
Private Const WINEVENT_OUTOFCONTEXT As Long = 0
'---------------------------------------------------------
'Subclassing APIs and Constants
'---------------------------------------------------------
Private Declare PtrSafe Function SetWindowLongPtr _
Lib "user32" Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function CallWindowProc _
Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As LongPtr, _
ByVal hWnd As LongPtr, _
ByVal iMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare PtrSafe Function lstrlenW _
Lib "kernel32" _
(ByVal lpString As LongPtr) As Long
Private Const GWLP_WNDPROC As Long = (-4)
Private Const WM_NOTIFY As Long = &H4E
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETTOPINDEX As Long = (LVM_FIRST + 39)
Private Const LVM_GETSTRINGWIDTHW = (LVM_FIRST + 87)
'---------------------------------------------------------
'Timer APIs
'---------------------------------------------------------
Private Declare PtrSafe Function SetTimer _
Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As Long
Public Declare PtrSafe Function KillTimer Lib _
"user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Const LISTVIEW_NAME As String = "SysListView32"
Private Const REDUNDANT_LV_STRING As String = "W"
Private mHHook As LongPtr
Private mHListView As LongPtr
Private mPrevWndProc As LongPtr
Private mTimerId As Long
Private mFormulas As Collection
Private mHasFormulas As Boolean
Private mOldA1Value As Variant
Public Property Get GrabbedFormulas() As Collection
Set GrabbedFormulas = mFormulas
End Property
Public Property Get HasGrabbedFormulas() As Boolean
HasGrabbedFormulas = mHasFormulas
End Property
Public Sub GrabEm()
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'ONLY CALL THIS ROUTINE FROM THE WORKSHEET ITSELF.
'EITHER A SHEET BUTTON OR WORKSHEET EVENT WOULD BE OKAY.
'RUNNING FROM VBA EDITOR WILL DO SERIOUS DAMAGE TO YOUR WORK.
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim ws As Worksheet
On Error GoTo EH
'Warning
MsgBox _
"Please do not touch the keyboard or activate another window." & vbNewLine & vbNewLine & _
"We are about to grab all of the workbook formulas by simulating key strokes on this sheet. " & vbNewLine & vbNewLine & _
"This routine will take a few seconds.", _
vbOKOnly, _
"Formula Grabber"
'Initialise.
Set mFormulas = New Collection
mHasFormulas = False
Set ws = ThisWorkbook.Worksheets(1)
With ws
.Visible = xlSheetVisible
.Activate
With .Range("A1")
mOldA1Value = .Value
.Select
End With
End With
'First task is to find the SysListView32 handle.
'We'll hook a EVENT_OBJECT_CREATE win event, which
'we can 'coerce' by entering "=a" in a cell.
If mHHook <> 0 Then DetachHook
mHHook = SetWinEventHook(EVENT_OBJECT_CREATE, _
EVENT_OBJECT_CREATE, _
0, _
AddressOf WinEventProc, _
0, _
0, _
WINEVENT_OUTOFCONTEXT)
RunKeySequence Asc("a")
Do While Not mHasFormulas
DoEvents
Loop
EH:
ws.Range("A1").Value = mOldA1Value
ReleaseAll
End Sub
Private Function WinEventProc(ByVal hWinEventHook As LongPtr, _
WinEvent As Long, _
ByVal hWnd As LongPtr, _
ByVal idObject As Long, _
ByVal idChild As Long, _
ByVal idEventThread As Long, _
ByVal dwmsEventTime As Long) As Long
On Error GoTo EH
'We don't want to handle or subclass a window created by a different process.
If Not IsSameProcess(hWnd) Then Exit Function
'Disregard any class that isn't a SysListView32.
If Not IsListView(hWnd) Then Exit Function
'We have the handle, so now we can release the hook
'and create a subclass.
'Note: store the handle for emergency hook destruction.
mHListView = hWnd
DetachHook
mPrevWndProc = SetWindowLongPtr(mHListView, _
GWLP_WNDPROC, _
AddressOf SubbedWndProc)
Exit Function
EH:
End Function
Private Function SubbedWndProc(ByVal hWnd As LongPtr, _
ByVal iMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Dim str As String
On Error Resume Next
'The two messages we're interested in are:
'1. LVM_GETSTRINGWIDTHW which is sent
' for each item to size the window.
'2. LVM_GETTOPINDEX which is sent once
' all strings are measured.
Select Case iMsg
Case LVM_GETSTRINGWIDTHW
'A pointer to the string is passed in lParam.
str = PointerToString(lParam)
If str <> REDUNDANT_LV_STRING Then
mFormulas.Add str, str
End If
Case LVM_GETTOPINDEX
'We're ready to move on to next keystroke.
RunKeySequence
End Select
'We're not overriding anything, so pass all messages
'to previous window procedure.
SubbedWndProc = CallWindowProc(mPrevWndProc, _
hWnd, _
iMsg, _
wParam, _
lParam)
End Function
Private Sub RunKeySequence(Optional startKey As Long)
Static key As Long
On Error GoTo EH
'Pause the timer.
StopTimer
'Start the sequence.
If startKey <> 0 Then
key = startKey
Application.SendKeys "="
Application.SendKeys chr(key)
Else
key = key + 1
End If
'End the sequence.
If key < Asc("a") Or key > Asc("z") Then
'Destroy the subclass.
Unsubclass
'Clear the cell.
Application.SendKeys "{BACKSPACE}"
Application.SendKeys "{BACKSPACE}"
Application.SendKeys "{ENTER}"
mHasFormulas = True
Exit Sub
End If
'Send the next keys.
StartTimer
Application.SendKeys "{BACKSPACE}"
'Note: API timer is used in case no formulas begin with
'the entered letter (ie no message would then be
'sent to our wnd proc) so we can time out that letter.
Application.SendKeys chr(key)
Exit Sub
EH:
End Sub
Private Sub StartTimer()
On Error Resume Next
mTimerId = SetTimer(0, 0, 1000, AddressOf TimerProc)
End Sub
Private Sub StopTimer()
On Error Resume Next
KillTimer 0, mTimerId
End Sub
Private Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
RunKeySequence
End Sub
Private Sub DetachHook()
On Error Resume Next
UnhookWinEvent mHHook
mHHook = 0
End Sub
Private Sub Unsubclass()
On Error Resume Next
SetWindowLongPtr mHListView, GWLP_WNDPROC, mPrevWndProc
mPrevWndProc = 0
End Sub
Private Function IsSameProcess(hWnd) As Boolean
Dim windowId As Long, currentId As Long
On Error GoTo EH
GetWindowThreadProcessId hWnd, windowId
currentId = GetCurrentProcessId
IsSameProcess = (windowId = currentId)
Exit Function
EH:
End Function
Private Function IsListView(hWnd) As Boolean
Dim ret As Long
Dim str As String * 128
Dim clsName As String
On Error GoTo EH
ret = GetClassName(hWnd, str, Len(str))
clsName = Left(str, ret)
IsListView = (clsName = LISTVIEW_NAME)
Exit Function
EH:
End Function
Private Function PointerToString(psz As LongPtr) As String
Dim buffer As Long
Dim str As String
On Error GoTo EH
buffer = lstrlenW(psz) * 2
str = Space(buffer)
CopyMemory ByVal str, ByVal psz, buffer
PointerToString = Replace(str, chr(0), "")
Exit Function
EH:
End Function
Public Sub ReleaseAll()
StopTimer
Unsubclass
DetachHook
End Sub
Function nested index = 2 Expression = AVERAGE(A1:A3) Formula = AVERAGE Evaluated result = 2
Function nested index = 3 Expression = COUNT(A1:A3) Formula = COUNT Evaluated result = 3
Function nested index = 4 Expression = IF(A1 = 2, 2,"c" & 3) Formula = IF Evaluated result = "c3"
Function nested index = 5 Expression = IF(A1*3 = 3, 6, "c3") Formula = IF Evaluated result = 6
I have developed a compact suggestion in VBA , which is here awaiting review on Code Review . It should be easily repurposed into a direct solution for this question.
This suggestion is a single function NameIsValid(name)
, which evaluates a string and determines if it is a valid name in Excel. With appropriate safeguards in place, it does so by splicing the name
into a call to LET()
, which it then executes using Application.Evaluate()
. An invalid name will yield an Error
.
' Check if a name is valid: it may be "declared" in Excel using LET().
Public Function NameIsValid(name As String) As Boolean
' Invalidate names that are empty or too long.
If name = Empty Or VBA.Len(name) > 255 Then
NameIsValid = False
' Invalidate reserved names: "R" and "C".
ElseIf ( _
name = "C" Or name = "c" Or _
name = "R" Or name = "r" _
) Then
NameIsValid = False
' Invalidate names with external whitespace (or double spaces internally),
' which are invalid in names and yet could mesh syntactically with
' formulaic calls to LET() in Excel.
ElseIf name <> Application.WorksheetFunction.Clean(VBA.Trim(name)) Then
NameIsValid = False
' Invalidate names with injection characters, which are invalid in names
' and also disrupt formulaic calls to LET() in Excel.
ElseIf ( _
VBA.InStr(1, name, "(") Or _
VBA.InStr(1, name, ",") Or _
VBA.InStr(1, name, ";") Or _
VBA.InStr(1, name, ")") _
) Then
NameIsValid = False
' If we pass the above checks, we can safely splice the name into a
' formulaic declaration with LET() in Excel.
Else
' Get the result of formulaically declaring a name with LET() in Excel.
Dim eval As Variant
eval = Application.Evaluate("= LET(" & name & ", 0, 0)")
' Check if the declaration erred due to invalid nomenclature.
If IsError(eval) Then
NameIsValid = False
Else
NameIsValid = True
End If
End If
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.