Public Function GetSelectableFormula_Open(ByRef oDataObject As DataObject, _
ByRef bFBVisible As Boolean, ByRef oActiveCell As Range) As Long
' Initialize for GetSelectableFormula
' See there
' 28.10.2010, Gg: created
Dim lXLhwnd As Long, lFBhwnd As Long
Dim MyName As String
MyName = "GetSelectableFormula_Open"
' Initialize
GetSelectableFormula_Open = 0
On Error GoTo Oops
'store the FBar visible state.
bFBVisible = Application.DisplayFormulaBar
'get the FBar hwnd.
lXLhwnd = FindWindowEx(0, 0, "XLMAIN", Application.Caption)
lFBhwnd = FindWindowEx(lXLhwnd, 0, "EXCEL<", vbNullString)
'lock the screen update.
If EGF_LOCK Then LockWindowUpdate lXLhwnd
'store the activecell.
Application.Windows(ThisWorkbook.Name).Activate
Set oActiveCell = ActiveCell
'show the FBar.
If Not bFBVisible Then Application.DisplayFormulaBar = True
'get a pointer to the dataobject interface.
Set oDataObject = _
GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'return function with the FBar handle.
GetSelectableFormula_Open = lFBhwnd
Exit Function
Oops:
LockWindowUpdate 0
DoEvents
If Not oActiveCell Is Nothing Then oActiveCell.Select
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, MyName
End Function
Public Function GetSelectableFormula(aSelectable As Object, _
lFBhwnd As Long, oDataObject As DataObject) As String
' Get the formula out of a selectable Object aSelectable. This can be anything, e.g.
' a DataLabel, a ChartTitle, a cell - whatever.
' Returns nullstring if no formula.
' The other parameters are delivered by a preceeeding call to GetSelectableFormula_Open
' - lFBhwnd must be the formula bar window handle.
' - oDataObject must be a dataobject interce object
'
' Usage:
' ' get the current context and the formula bar window handle
' lFBhwnd = GetSelectableFormula_Open(oDataObject, bFBVisible, oActiveCell)
' ' process all objects you want
' ...
' formula = GetSelectableFormula(aSelectable, lFBhwnd, oDataObject)
' ...
' ' restore the former context
' Call GetSelectableFormula_Close(oDataObject, bFBVisible, oActiveCell)
'
' Alternative, which does all three steps in one:
' formula = GetSelectableFormula_DoesAll(aSelectable)
'
' 27.10.2010: Original by Jaafar Tribak, slightly modified by Werner Geiger (Gg):
' - local instead of global variables
' - Public instead of Private
' - better error message
' - locking and waiting controlled by global constants
' - return nullstring if no formula
' 28.10.2010, Gg: Any selectable object as parameter
' 28.10.2010, Gg: Splitted into three parts
Dim t As Single
Dim MyName As String
MyName = "GetSelectableFormula"
' Initialize
GetSelectableFormula = ""
On Error GoTo Oops
'select the object.
aSelectable.Select
'set the keyboard focus on the FBar.
PostMessage lFBhwnd, WM_SETFOCUS, 0, 0
PostMessage lFBhwnd, WM_LBUTTONDOWN, 0, 0
'clear the clipboard.
OpenClipboard 0
EmptyClipboard
CloseClipboard
'copy the FBar text to the clipboard.
With Application
.SendKeys "{HOME}"
.SendKeys "^+{END}"
.SendKeys "^c"
.SendKeys "{ESC}"
End With
'retrieve the text from clipboard.
oDataObject.GetFromClipboard
'run a brief delay to take effect.
'@@Gg: why?
t = Timer
Do
DoEvents
Loop Until Timer - t >= EGF_WAIT
'return function with the FBar text.
GetSelectableFormula = oDataObject.GetText()
' but not if it is no formula
If Left(GetSelectableFormula, 1) <> "=" Then _
GetSelectableFormula = ""
Exit Function
Oops:
LockWindowUpdate 0
DoEvents
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, MyName
End Function
Public Function GetSelectableFormula_Close(oDataObject As DataObject, _
bFBVisible As Boolean, oActiveCell As Range) As Boolean
' Finalize for GetSelectableFormula
' See there
' 28.10.2010, Gg: created
Dim t As Single
Dim MyName As String
MyName = "GetSelectableFormula_Close"
' Initialize
GetSelectableFormula_Close = False
On Error GoTo Oops
'restore the FBar initial visible state.
Application.DisplayFormulaBar = bFBVisible
'select back the activecell.
oActiveCell.Select
'cleanup.
Set oDataObject = Nothing
'restore the screen updating.
LockWindowUpdate 0
DoEvents
'return function
GetSelectableFormula_Close = True
Exit Function
Oops:
On Error GoTo 0
LockWindowUpdate 0
DoEvents
If Not oActiveCell Is Nothing Then oActiveCell.Select
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbExclamation, MyName
End Function
