Classes – Desktop liberation

cHeadingRow

March 30, 2019 Comments Off

Summary This is a special type of cDataRow and is used for managing the column headers of a cDataSet You can find the methods and properties documentation on github. And the source code is on Gitbub or below

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/18/2014 4:47:43 PM : from manifest:3414394 gist https://gist.github.com/brucemcpherson/3414216/raw/cHeadingRow.cls
' a collection of Cells that contain the headings associated with a dataset
' v2.03 - 3414216
Option Explicit
'for more about this
' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
Private pDataRow As cDataRow
Public Property Get parent() As cDataSet
    Set parent = pDataRow.parent
End Property
Public Property Get dataRow() As cDataRow
    Set dataRow = pDataRow
End Property
Public Property Get headings() As Collection
    Set headings = pDataRow.columns
End Property
Public Property Get where() As Range
    Set where = pDataRow.where
End Property
Public Function create(dset As cDataSet, rHeading As Range, Optional keepFresh As Boolean = False) As cHeadingRow
    Dim rCell As Range, hcell As cCell, n As Long, dr As cDataRow

    With pDataRow
        .create dset, rHeading, 0, keepFresh
    End With
    Set create = Me
End Function
Public Function exists(s As String) As cCell
    If headings.count > 0 Then
        On Error GoTo handle
        Set exists = headings(makeKey(s))
        Exit Function
    End If
handle:
    Set exists = Nothing
End Function
Public Property Get headingList() As String
    ' return a comma separated list of the headings
    Dim t As cStringChunker, cc As cCell
    Set t = New cStringChunker
    For Each cc In headings
        t.add cc.toString & ","
    Next cc
    ' remove final comma if there is one
    headingList = t.chop.content
    Set t = Nothing
End Property

Public Function validate(complain As Boolean, ParamArray args() As Variant) As Boolean
    Dim i As Long, s As String
    s = ""
    For i = LBound(args) To UBound(args)
        If exists(CStr(args(i))) Is Nothing Then
            s = s & args(i) & ","
        End If
    Next i
    If Len(s) = 0 Then
        validate = True
    Else
        s = left(s, Len(s) - 1)
        If complain Then
            MsgBox "The following required columns are missing from dataset " & parent.name & ":" & s
        End If
    End If
End Function
Public Sub tearDown()
    ' clean up
    pDataRow.tearDown
    Set pDataRow = Nothing
End Sub

Private Sub Class_Initialize()
    Set pDataRow = New cDataRow
End Sub

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/18/2014 4:47:43 PM : from manifest:3414394 gist https://gist.github.com/brucemcpherson/3414216/raw/cHeadingRow.cls

' a collection of Cells that contain the headings associated with a dataset

' v2.03 - 3414216

Option Explicit

'for more about this

' http://ramblings.mcpher.com/Home/excelquirks/classeslink/data-manipulation-classes

'to contact me

' http://groups.google.com/group/excel-ramblings

'reuse of code

' http://ramblings.mcpher.com/Home/excelquirks/codeuse

Private pDataRow As cDataRow

Public Property Get parent() As cDataSet

Set parent = pDataRow.parent

End Property

Public Property Get dataRow() As cDataRow

Set dataRow = pDataRow

End Property

Public Property Get headings() As Collection

Set headings = pDataRow.columns

End Property

Public Property Get where() As Range

Set where = pDataRow.where

End Property

Public Function create(dset As cDataSet, rHeading As Range, Optional keepFresh As Boolean = False) As cHeadingRow

Dim rCell As Range, hcell As cCell, n As Long, dr As cDataRow

With pDataRow

.create dset, rHeading, 0, keepFresh

End With

Set create = Me

End Function

Public Function exists(s As String) As cCell

If headings.count > 0 Then

On Error GoTo handle

Set exists = headings(makeKey(s))

Exit Function

End If

handle:

Set exists = Nothing

End Function

Public Property Get headingList() As String

' return a comma separated list of the headings

Dim t As cStringChunker, cc As cCell

Set t = New cStringChunker

For Each cc In headings

t.add cc.toString & ","

Next cc

' remove final comma if there is one

headingList = t.chop.content

Set t = Nothing

End Property

Public Function validate(complain As Boolean, ParamArray args() As Variant) As Boolean

Dim i As Long, s As String

s = ""

For i = LBound(args) To UBound(args)

If exists(CStr(args(i))) Is Nothing Then

s = s & args(i) & ","

End If

Next i

If Len(s) = 0 Then

validate = True

Else

s = left(s, Len(s) - 1)

If complain Then

MsgBox "The following required columns are missing from dataset " & parent.name & ":" & s

End If

End Function

Public Sub tearDown()

' clean up

pDataRow.tearDown

Set pDataRow = Nothing

End Sub

Private Sub Class_Initialize()

Set pDataRow = New cDataRow

End Sub

cDataColumn

March 30, 2019 Comments Off

Summary This is a column of cCell . The rowId argument refers to the row either by row name (where we have enabled labels) or a row number. Where rowId optional and omitted the complete column is operated on. Where rowId is present the the cCell it […]

cDataRow

March 30, 2019 Comments Off

This is a row of cCell . The sid argument refers to the column either by column name or number. Where sid optional and omitted the complete row is operated on. Where sid is present the cCell it addresses in the cDataRow is operated on. For example cDataRow.Refresh() […]

Promises in VBA

March 29, 2019 Comments Off

Using promises in JavaScript and other languages is the preferred way to orchestrate the completion of asynchronous activities. Here’s a (not perfect but fun) Promise implementation in VBA. Example includes getting data from Google Fusion tables. […]

cDataSet Model

March 29, 2019 Comments Off

What to download: All the examples contain all the classes needed for them to work and all projects can be found here. If you just want the main utility classes used throughout this site, in […]

CDataSets

March 23, 2019 Comments Off

Summary This is a collection of cDataSet You can find the methods and properties documentation on github. And the source code is here

cCell Class

March 21, 2019 Comments Off

This class addresses and manipulates a single excel cell and its contents. You can find the methods and properties documentation on github. The code is also below

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/18/2014 4:47:40 PM : from manifest:3414394 gist https://gist.github.com/brucemcpherson/3414216/raw/cCell.cls
' a data Cell - holds value at time of loading, or can be kept fresh if there might be formula updates
Option Explicit
' Version 2.04 -
'for more about this
' https://ramblings.com/data-manipulation-classes
'to contact me
' http://groups.google.com/group/excel-ramblings
'reuse of code
' http://ramblings.mcpher.com/Home/excelquirks/codeuse
Private pValue As Variant                   ' value of cell when first loaded
Private pColumn As Long                     ' column number
Private pParent As cDataRow                 ' cDataRow to which this belongs
Public Property Get row() As Long
    row = pParent.row
End Property
Public Property Get column() As Long
    column = pColumn
End Property
Public Property Get parent() As cDataRow
    Set parent = pParent
End Property
Public Property Get myKey() As String
    myKey = makeKey(pParent.parent.headings(pColumn).toString)
End Property

Public Property Get where() As Range    ' return the range from whence it came
    If row = 0 Then
    ' its a heading
        Set where = pParent.where.Resize(1, 1).Offset(row, pColumn - 1)
    Else
        Set where = pParent.where.Resize(1, 1).Offset(, pColumn - 1)
    End If
End Property
Public Property Get refresh() As Variant ' refresh the current value and return it
    pValue = where.value
    refresh = pValue
End Property
Public Property Get toString(Optional sFormat As String = vbNullString, _
            Optional followFormat As Boolean = False, _
            Optional deLocalize As Boolean = False) As String ' Convert to a string, applying a format if supplied
    Dim s As String, os As String, ts As String
    If Len(sFormat) > 0 Then
        os = Format(value, sFormat)
    Else
        If followFormat Then
            s = where.NumberFormat
            If Len(s) > 0 And s <> "General" Then
                os = Format(value, s)
            Else
                os = CStr(value)
            End If
        Else
            os = CStr(value)
        End If
    End If
    
    If deLocalize Then
        If VarType(value) = vbDouble Or VarType(value) = vbCurrency Or VarType(value) = vbSingle Then
            ' commas to dots
            ts = Mid(CStr(1.1), 2, 1)
            os = Replace(os, ts, ".")
            
        ElseIf VarType(value) = vbBoolean Then
        
            If value Then
                os = "true"
            Else
                os = "false"
            
            End If
        
        End If
    
    End If
    toString = os
    
End Property
Public Property Get value() As Variant   ' return the value, refreshing it if necessary
    If pParent.parent.keepFresh Then
        value = refresh
    Else
        value = pValue
    End If
End Property
Public Property Let value(p As Variant)
    parent.parent.columns(pColumn).dirty = True
    If pParent.parent.keepFresh Then
        Commit p
    Else
        pValue = p
    End If
End Property
Public Function needSwap(cc As cCell, e As eSort) As Boolean
    ' this can be used from a sorting alogirthm
    Select Case e
        Case eSortAscending
            needSwap = LCase(toString) > LCase(cc.toString)
            
        Case eSortDescending
            needSwap = LCase(toString) < LCase(cc.toString)
    
        Case Else
            needSwap = False
    End Select
End Function
Public Function Commit(Optional p As Variant) As Variant
    Dim v As Variant
    If Not IsMissing(p) Then
        pValue = p
    End If
    
    where.value = pValue
    Commit = refresh

End Function
Public Function create(par As cDataRow, colNum As Long, rCell As Range, _
            Optional v As Variant) As cCell        ' Fill the Cell up
    
    ' if v is specifed we knw the value without needing to access the sheet
    If IsMissing(v) Then
        pValue = rCell.value
    Else
        pValue = v
    End If
    pColumn = colNum
    Set pParent = par
    Set create = Me                     ' return for convenience
End Function


Public Sub tearDown()
    ' clean up
    Set pParent = Nothing
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/18/2014 4:47:40 PM : from manifest:3414394 gist https://gist.github.com/brucemcpherson/3414216/raw/cCell.cls

' a data Cell - holds value at time of loading, or can be kept fresh if there might be formula updates

Option Explicit

' Version 2.04 -

'for more about this

' https://ramblings.com/data-manipulation-classes

'to contact me

' http://groups.google.com/group/excel-ramblings

'reuse of code

' http://ramblings.mcpher.com/Home/excelquirks/codeuse

Private pValue As Variant ' value of cell when first loaded

Private pColumn As Long ' column number

Private pParent As cDataRow ' cDataRow to which this belongs

Public Property Get row() As Long

row = pParent.row

End Property

Public Property Get column() As Long

column = pColumn

End Property

Public Property Get parent() As cDataRow

Set parent = pParent

End Property

Public Property Get myKey() As String

myKey = makeKey(pParent.parent.headings(pColumn).toString)

End Property

Public Property Get where() As Range ' return the range from whence it came

If row = 0 Then

' its a heading

Set where = pParent.where.Resize(1, 1).Offset(row, pColumn - 1)

Else

Set where = pParent.where.Resize(1, 1).Offset(, pColumn - 1)

End If

End Property

Public Property Get refresh() As Variant ' refresh the current value and return it

pValue = where.value

refresh = pValue

End Property

Public Property Get toString(Optional sFormat As String = vbNullString, _

Optional followFormat As Boolean = False, _

Optional deLocalize As Boolean = False) As String ' Convert to a string, applying a format if supplied

Dim s As String, os As String, ts As String

If Len(sFormat) > 0 Then

os = Format(value, sFormat)

Else

If followFormat Then

s = where.NumberFormat

If Len(s) > 0 And s <> "General" Then

os = Format(value, s)

Else

os = CStr(value)

End If

Else

os = CStr(value)

End If

If deLocalize Then

If VarType(value) = vbDouble Or VarType(value) = vbCurrency Or VarType(value) = vbSingle Then

' commas to dots

ts = Mid(CStr(1.1), 2, 1)

os = Replace(os, ts, ".")

ElseIf VarType(value) = vbBoolean Then

If value Then

os = "true"

Else

os = "false"

End If

toString = os

End Property

Public Property Get value() As Variant ' return the value, refreshing it if necessary

If pParent.parent.keepFresh Then

value = refresh

Else

value = pValue

End If

End Property

Public Property Let value(p As Variant)

parent.parent.columns(pColumn).dirty = True

If pParent.parent.keepFresh Then

Commit p

Else

pValue = p

End If

End Property

Public Function needSwap(cc As cCell, e As eSort) As Boolean

' this can be used from a sorting alogirthm

Select Case e

Case eSortAscending

needSwap = LCase(toString) > LCase(cc.toString)

Case eSortDescending

needSwap = LCase(toString) < LCase(cc.toString)

Case Else

needSwap = False

End Select

End Function

Public Function Commit(Optional p As Variant) As Variant

Dim v As Variant

If Not IsMissing(p) Then

pValue = p

End If

where.value = pValue

Commit = refresh

End Function

Public Function create(par As cDataRow, colNum As Long, rCell As Range, _

Optional v As Variant) As cCell ' Fill the Cell up

' if v is specifed we knw the value without needing to access the sheet

If IsMissing(v) Then

pValue = rCell.value

Else

pValue = v

End If

pColumn = colNum

Set pParent = par

Set create = Me ' return for convenience

End Function

Public Sub tearDown()

' clean up

Set pParent = Nothing

End Sub

cDataSet

March 21, 2019 Comments Off

Summary This is a block of cCell consisting of a collection of cDataRow, with an abstraction of a collection of cDataColumn The sid argument refers to the column either by column name or number and the rowID refers to the particular row by number, […]