Some required Functions
PHP Code:
Private Function objColour(strCell As String) As String
objColour = "#" & Right(Right("000000" & Hex(strCell), 6), 2) & Mid(Right("000000" & Hex(strCell), 6), 3, 2) & Left(Right("000000" & Hex(strCell), 6), 2)
End Function
Private Function FontAlignment(ByVal objCell As Object) As String
With objCell
Select Case .HorizontalAlignment
Case xlLeft
FontAlignment = "LEFT"
Case xlRight
FontAlignment = "RIGHT"
Case xlCenter
FontAlignment = "CENTER"
Case Else
Select Case VarType(.Value2)
Case 8
FontAlignment = "LEFT"
Case 10, 11
FontAlignment = "CENTER"
Case Else
FontAlignment = "RIGHT"
End Select
End Select
End With
End Function
Private Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
X = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
Private Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
Optional ReturnColorIndex As Long = True) As Long
Dim X As Long, Test As Boolean, CurrentCell As String, dColor As Variant
Dim F As String, R As Range
'//Original code is written by Rick Rothstein
'//http://www.excelfox.com/forum/f22/get-displayed-cell-color-whether-from-conditional-formatting-or-not-338/
If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
CurrentCell = ActiveCell.Address(0, 0)
For X = 1 To Cell.FormatConditions.Count
With Cell.FormatConditions(X)
If .Type = xlCellValue Then
Select Case .Operator
Case xlBetween: Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
Case xlNotBetween: Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
Case xlEqual: Test = Evaluate(.Formula1) = Cell.Value
Case xlNotEqual: Test = Evaluate(.Formula1) <> Cell.Value
Case xlGreater: Test = Cell.Value > Evaluate(.Formula1)
Case xlLess: Test = Cell.Value < Evaluate(.Formula1)
Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
Case xlLessEqual: Test = Cell.Value <= Evaluate(.Formula1)
End Select
ElseIf .Type = xlExpression Then
Application.ScreenUpdating = False
'Cell.Select
F = Replace(.Formula1, "$", vbNullString)
F = Replace(F, CurrentCell, Cell.Address(0, 0))
'Test = Evaluate(.Formula1)
Test = Evaluate(F)
'Range(CurrentCell).Select
Application.ScreenUpdating = True
End If
If Test Then
If CellInterior Then
dColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
If IsNull(dColor) Then
dColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
End If
Else
dColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
If IsNull(dColor) Then
dColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
End If
End If
DisplayedColor = dColor
Exit Function
End If
End With
Next
If CellInterior Then
dColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
Else
dColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
End If
DisplayedColor = dColor
End Function
'
Private Function ExcelVersion() As String
Dim temp As String
'On Error Resume Next
#If Mac Then
Select Case Val(Application.Version)
Case 11: temp = "Excel 2004"
Case 12: temp = "Excel 2008" ' this should NEVER happen!
Case 14: temp = "Excel 2011"
Case 15: temp = "vNext"
Case Else: temp = "Unknown"
End Select
#Else
Select Case Val(Application.Version)
Case 9: temp = "Excel 2000"
Case 10: temp = "Excel 2002"
Case 11: temp = "Excel 2003"
Case 12: temp = "Excel 2007"
Case 14: temp = "Excel 2010"
Case 15: temp = "Excel 2013"
Case Else: temp = "Unknown"
End Select
#End If
ExcelVersion = temp
End Function
'
'
Private Function ColLtr(ByVal iCol As Long) As String
' shg 2012 http://www.excelfox.com/forum/f13/summary-of-maximum-rows-used-across-each-sheet-in-a-workbook-2053/#post9482
' Good for any positive Long
If iCol > 0 Then
ColLtr = ColLtr((iCol - 1) \ 26) & Chr(65 + (iCol - 1) Mod 26)
Else
End If
End Function
Reply With Quote
Bookmarks