PDA

View Full Version : Class problems



mmhmm
09-24-2011, 01:59 AM
Hi all,
I intend to build a dictionary(collection) of sheets name and data+time pairs using class, the problem i got is
1. i can't get the instance of the class to be shared among Subs in ThisWorkbook module, basically i want the instance to be alive from opening of the workbook to its closing so other Subs like WorkSheet_Changed, Workbook_Save can work on it.

2. I tried to assign a data + time to an element in the dictionary
Set d = New myclass
d.keysupd(sh.Name) = Date & " " & Time
how do i write the procedure keysupd to accept date + time which i don't know how to start, sh.Name is the sheet name(key)

Here's a sample of my workbook

Please help.:doh:

Bob Phillips
09-24-2011, 09:16 AM
Your digital signature is invalid, so we won't be opning that.

mmhmm
09-24-2011, 06:24 PM
Here's an excel file without my cert. :(

GTO
09-24-2011, 06:29 PM
I cannot open .xls(m/x/whatever) at home, so this is a total stab in the dark. If ThisWorkbook is the only place you are using the dic, why not build it there?

mikerickson
09-24-2011, 09:49 PM
I haven't looked at your file, but to have an instance of a custom class persist, the variable has to be declared Public in a normal module, not ThisWorkbook.

' in a Normal module

Public classVar As Class1

Then if the Workbook_Open event initializes the variable, it will persist.

'in thisworkbook

Private Sub Workbook_Open()
Call MakeCustomInstance
End Sub

Public Sub MakeCustomInstance()
Set classVar = New Class1
Set classVar.mySheet = Sheet1
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If classVar Is Nothing Then
Call MakeCustomInstance
End If
End Sub

If the End command is run, or something crashes, the instance will be destroyed. Hence the SheetActive event to repair that if possible.

mmhmm
09-24-2011, 10:21 PM
Thanks for the answer to 1. of my problems, about 2. i just can't figure it out, normally d.propertyVariable= value is used to assign value to property of a class, but now the propertyVariable (d.keysupd(sh.Name) = Date & " " & Time ) is a value property of a dictionary which in turn accepting the key sh.name. how to write the code in the class module to allow the use of this line d.keysupd(sh.Name) = Date & " " & Time ?

Bob Phillips
09-25-2011, 02:56 AM
Still invalid

mikerickson
09-25-2011, 10:26 AM
This is one way that you could assign that string to each worksheet.


' Rem in Class1 module

Dim NameName As String

Property Get DTStamp(ws As Variant) As String
Select Case TypeName(ws)
Case "String", "Long", "Double", "Integer", "Byte", "Single"
Set ws = ThisWorkbook.Worksheets(ws)
Case "Worksheet"
Case Else
Set ws = Nothing
End Select

If TypeName(ws) = "Worksheet" Then
DTStamp = Evaluate(ws.Names(NameName).RefersTo)
End If
End Property

Property Let DTStamp(ws As Variant, DTValue As String)
Select Case TypeName(ws)
Case "String", "Long", "Double", "Integer", "Byte", "Single"
Set ws = ThisWorkbook.Worksheets(ws)
Case "Worksheet"
Case Else
Set ws = Nothing
End Select

If TypeName(ws) = "Worksheet" Then
With ws
.Names.Add Name:=NameName, RefersTo:="=" & Chr(34) & DTValue & Chr(34)
.Names(NameName).Visible = False
End With
End If
End Property

Private Sub Class_Initialize()
NameName = "DTStamp"
End Sub

Private Sub Class_Terminate()
Dim oneSheet As Worksheet
For Each oneSheet In ThisWorkbook.Worksheets
oneSheet.Names(NameName).Delete
Next oneSheet
End Sub
' in Normal module
Public myVar As New Class1

Sub test()
Set myVar = New Class1
myVar.DTStamp("Sheet1") = CStr(Now)
End Sub

Sub trial()
MsgBox myVar.DTStamp(1)
End SubNote that DTStamp will take a sheet name, it's index or the worksheet object itself as the argument.

mmhmm
09-25-2011, 08:04 PM
I put together all those info i got from you guys, thanks and come up with the following code, but still not working :dunno, please help to debug.


'in module1

Public d As myclass



'in ThisWorkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a, b
a = d.ka
b = d.ia
For i = 0 To d.countd
If b(i) <> 0 Then
Debug.Print a(i) & " " & b(i)
End If
Next
d.remove
End Sub
Private Sub Workbook_Open()
Dim d As New myclass
Debug.Print TypeName(d) & " wo"
For Each ws In ThisWorkbook.Sheets
d.add2Collection ws.Name, 0
Next
End Sub
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Debug.Print TypeName(d) & " wsc"
If d.isExists(sh.Name) = False Then
d.add2Collection sh.Name, Date & " " & Time
Else
d.keysupd(sh.Name) = Date & " " & Time
End Sub




' in myclass Class module

Dim dd
Public Sub add2Collection(ByVal sh As String, ByVal dt)
dd.Add sh, dt
End Sub
Private Sub Class_Initialize()
Debug.Print "hi"
Set dd = CreateObject("Scripting.Dictionary")
dd.CompareMode = vbTextCompare
End Sub
Public Function isExists(ByVal sh As String) As Boolean
isExists = False
If dd.Exists(sh) Then isExists = True
End Function
Public Property Get ka()
ka = dd.keys
End Property
Public Property Get ia()
ia = dd.items
End Property
Public Property Get keysupd(ByVal ws As String) As String
keysupd = dd.keys(ws)
End Property
Public Property Let keysupd(ByVal ws As String, ByVal dt As String)
dd.keys(ws) = dt
End Property
Public Function countd()
countd = dd.keys.Count
End Function
Public Sub remove()
dd.RemoveAll
End Sub


I know is almost there i know, the code will log the last update of all sheets between save/ between open and save.: pray2: