Multi-compatible Excel xlsm - how to solve object/activex/reference issues

shell_l_d
07-08-2010, 05:05 PM
Having problems between different versions of Excel (& Windows)...

My spreadsheet has: 7 x worksheets

On Sheet1 ("Update") it has these:
2 x DTPickers shows: =EMBED("MSComCtl2.DTPicker.2","")
1 x combo box shows: =EMBED("Forms.ComboBox.1","")
2 x buttons shows nothing for formula - both call macros/procedures

Purpose: extracts data from a database (ADODB), puts results in few worksheets, creates tables, formatting, extra columns with calcs.

I can run the spreadsheet on my pc with Excel2007 (Win7), others can & others cant. Also fails on Excel2010 (WinVista), same errors as an Excel 2007 (WinVista) user. So seems to be working for Excel 2007 + Win7, but so far failing for (some/all?) Excel 2007/2010 + Vista.

Fails for Worksheets("Update") .Select & .Range("....") & on combobox code.
I can see the worksheet/ranges/combobox all exist & are named properly.

Error '32809 Application-defined or object-defined error' occurred in ThisWorkbook.Workbook_Open at line 15. ... same for lines 16 to 23.


Sub Workbook_Open()

' For Error Reporting
Dim sErrorDescription As String
Const sProcSig As String = MODULE_NAME & "Workbook_Open"
'On Error Resume Next
1 On Error GoTo Error_In_WorkbookOpen

2 With ActiveWorkbook

'Name cells for 'LAST UPDATE STATISTICS'
3 .Names.Add Name:="StartDate", RefersTo:="=Update!$E$5"
4 .Names.Add Name:="EndDate", RefersTo:="=Update!$E$8"
5 .Names.Add Name:="FilterField", RefersTo:="=Update!$E$11"
6 .Names.Add Name:="FilterFieldIndex", RefersTo:="=Update!$E$12"
7 .Names.Add Name:="LastUpdated", RefersTo:="=Update!$E$14"
8 .Names.Add Name:="UpdateStatus", RefersTo:="=Update!$E$15"

'Name cells for 'VB Libraries Info'
9 .Names.Add Name:="NumFoundLibs", RefersTo:="=Update!$E$20"
10 .Names.Add Name:="NumMissingLibs", RefersTo:="=Update!$E$21"
11 .Names.Add Name:="NumBrokenLibs", RefersTo:="=Update!$E$22"

' Clear values for 'VB Libraries Info' on 'Update' worksheet
12 Call ClearVbReferences

13 End With

14 With Worksheets("Update")

' Date/Time Format
15 .Range("StartDate").NumberFormat = "dd mmm yyyy"
16 .Range("EndDate").NumberFormat = "dd mmm yyyy"
17 .Range("LastUpdated").NumberFormat = "dd mmm yyyy"

' Fill combo box
18 .cbFilterField.Clear
19 .cbFilterField.AddItem ("CallTime")
20 .cbFilterField.AddItem ("TechComp")
21 .cbFilterField.AddItem ("CloseDate")
22 .cbFilterField.AddItem ("Calc Compl Date")
' Set default value
23 .cbFilterField.ListIndex = 0

24 End With

25 Call FixDTPickers

' ===== Exit Handler =====
Exit_WorkbookOpen:
26 Application.ScreenUpdating = True
27 Exit Sub

' ===== ERROR HANDLER =====
Error_In_WorkbookOpen:

28 With Err
29 sErrorDescription = "Error '" & .Number & " " & _
.Description & "' occurred in " & sProcSig & _
IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
30 End With

31 Select Case MsgBox(sErrorDescription, vbAbortRetryIgnore, "Error in " & sProcSig)
Case vbRetry
32 Resume
33 Case vbIgnore
34 Resume Next
35 Case Else
36 Resume Exit_WorkbookOpen
37 End
38 End Select

End Sub


Errors at line 12 > goes to Error Handler > fails at line 112 with:
Run-time error '32809'
Application-defined or object-defined error



Public Sub DataExtract()
...[more code]...
' Set 'last updated' statistics (dates)
4 Application.StatusBar = False
5 Application.ScreenUpdating = False
6 With ActiveWorkbook.Worksheets("Update")

' Obtain the start & end dates from the DTPickers
' this may cause errors... consider late binding of DTPickers
7 On Error Resume Next
8 dteStartDate = Format(.DTPickerStart, "yyyy-mm-dd")
9 dteEndDate = Format(.DTPickerEnd, "yyyy-mm-dd")
10 filterField = .cbFilterField.ListIndex
11 On Error GoTo Error_In_DataExtract

12 .Select
13 .Range("StartDate").Value = dteStartDate
14 .Range("EndDate").Value = dteEndDate
15 .Range("FilterField").Value = .cbFilterField.Value
16 .Range("FilterFieldIndex").Value = filterField
17 .Range("LastUpdated").Value = Date
18 .Range("UpdateStatus").Value = "Started"

19 End With
...[more code]...

' ===== ERROR HANDLER =====
Error_In_DataExtract:

'On Error Resume Next
110 Application.StatusBar = "Error occurred..."
111 With ActiveWorkbook.Worksheets("Update")
112 .Select
113 .Range("UpdateStatus").Value = "Failed"
114 End With
...[more code]...


Been testing with:
Excel 2007 with Vista / Win7
Excel 2010 with Vista

In Excel 2010: I deleted the 2 buttons from the "Update" worksheet & saved, closed, re-opened the spreadsheet to see if fixes problem. Problem still exists.

However... when I try to delete the combo box by selecting Design Mode > click combo box > Delete, it will crash excel. Will have to haven't tried removing the combo box using Excel 2007... anyhow just trying to pinpoint what object on the "Update" worksheet could be causing the errors/problems.

It would be so much easier if MS Office versions were multi-compatible... doh...


Any ideas please?

shell_l_d
07-09-2010, 02:47 AM
I'm trying to get around VB library/reference issues by using late binding of controls/activex objects on a userform (instead of early binding on a worksheet) I cant get my button Click methods to work at all. I've even added a msgbox in its code to see if it gets called & it doesnt.

Any ideas please?

I have a blank userform called 'ufrmUpdateData' & it has this code (so far):

'---------------------------------------------------------------------------------------
' Module : UserForm2
' Purpose : USER FORM CODE
'---------------------------------------------------------------------------------------

Private Const MODULE_NAME As String = "UserForm2."

Private Sub btnClose_Click()
MsgBox "clicked close"
'ufrmUpdateData.Hide
Unload Me
End Sub

Private Sub btnUpdateData_Click()
MsgBox "clicked update data now"
End Sub

Private Sub UserForm_Initialize()
'---------------------------------------------------------------------------------------
' Procedure : UserForm_Initialize
' Purpose : Creates controls (labels,combobox,buttons) on fly using
' late binding so uses correct VB library/reference
' DTPicker late binding code per post#5 by timbereng in:
' http://www.access-programmers.co.uk/forums/showthread.php?t=164021
'---------------------------------------------------------------------------------------

' For Error Reporting
Dim sErrorDescr As String
Const sErrSource As String = MODULE_NAME & "UserForm_Initialize"
On Error GoTo Error_In_UserForm_Initialize

' Late binding (As Object) of controls so uses correct VB library/reference
Dim oLblStartDate As Object, oLblEndDate As Object, oLblFilterOn As Object
Dim oCboFilterOn As Object
Dim oBtnUpdateData As Object, oBtnClose As Object
Dim oDtpStartDate As Object, oDtpEndDate As Object
Dim bHasDtPicker As Boolean

' Create control objects
Set oLblStartDate = Me.Controls.Add("Forms.Label.1", "lblStartDate", True)
Set oLblEndDate = Me.Controls.Add("Forms.Label.1", "lblEndDate", True)
Set oLblFilterOn = Me.Controls.Add("Forms.Label.1", "lblFilterOn", True)
Set oCboFilterOn = Me.Controls.Add("Forms.ComboBox.1", "cboFilterOn", True)
Set oBtnUpdateData = Me.Controls.Add("Forms.CommandButton.1", "btnUpdateData", True)
Set oBtnClose = Me.Controls.Add("Forms.CommandButton.1", "btnClose", True)

' Formatting properties
With oLblStartDate
.TabIndex = 0
.Top = 36
.Left = 36
.Height = 22
.Width = 72
.Caption = "Start Date:"
.Font.Size = 12
End With
With oLblEndDate
.TabIndex = 2
.Top = 84
.Left = 36
.Height = 22
.Width = 72
.Caption = "End Date:"
.Font.Size = 12
End With
With oLblFilterOn
.TabIndex = 4
.Top = 132
.Left = 36
.Height = 22
.Width = 72
.Caption = "Filter On:"
.Font.Size = 12
End With
With oCboFilterOn
.TabIndex = 5
.Top = 132
.Left = 120
.Height = 22
.Width = 132
.Font.Size = 12
.AddItem ("CallTime")
.AddItem ("TechComp")
.AddItem ("CloseDate")
.AddItem ("Calc Compl Date")
.ListIndex = 0 ' default value
End With
With oBtnUpdateData
.TabIndex = 6
.Top = 186
.Left = 30
.Height = 36
.Width = 126
.Caption = "Update Data Now"
.Font.Size = 12
End With
With oBtnClose
.TabIndex = 7
.Top = 186
.Left = 198
.Height = 36
.Width = 126
.Caption = "Close"
.Font.Size = 12
End With

'---------------------------
' DTPicker's
'---------------------------
On Error Resume Next
Set oDtpStartDate = Me.Controls.Add("MSComCtl2.DTPicker", "dtpStartDate", True)
Set oDtpEndDate = Me.Controls.Add("MSComCtl2.DTPicker", "dtpEndDate", True)

' If DTPicker doesnt exist, use text boxes instead
If Err.Number <> 0 Or oDtpStartDate Is Nothing Then
On Error GoTo Error_In_UserForm_Initialize
bHasDtPicker = False
Set oDtpStartDate = Me.Controls.Add("Forms.TextBox.1", "dtpStartDate", True)
Set oDtpEndDate = Me.Controls.Add("Forms.TextBox.1", "dtpEndDate", True)
oDtpStartDate.ControlTipText = "Enter date in format: dd mmm yyyy Eg: 01 Apr 2010"
oDtpEndDate.ControlTipText = "Enter date in format: dd mmm yyyy Eg: 31 Mar 2010"
Else
bHasDtPicker = True
oDtpStartDate.Format = dtpLongDate
oDtpEndDate.Format = dtpLongDate
End If

' Formatting properties
With oDtpStartDate
.TabIndex = 1
.Top = 84
.Left = 120
.Height = 22
.Width = 210
.Font.Size = 12
End With
With oDtpEndDate
.TabIndex = 3
.Top = 36
.Left = 120
.Height = 22
.Width = 210
.Font.Size = 12
End With

' ===== Exit Handler =====
Exit_UserForm_Initialize:
oLblStartDate = Nothing
oLblEndDate = Nothing
oLblFilterOn = Nothing
oCboFilterOn = Nothing
oBtnUpdateData = Nothing
oBtnClose = Nothing
oDtpStartDate = Nothing
oDtpEndDate = Nothing
Exit Sub

' ===== ERROR HANDLER =====
Error_In_UserForm_Initialize:

With Err
sErrorDescr = "Error '" & .Number & " " & _
.Description & "' occurred in " & sErrSource & _
IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
End With

Select Case MsgBox(sErrorDescr, vbAbortRetryIgnore, "Error in " & sErrSource)
Case vbRetry
Resume
Case vbIgnore
Resume Next
Case Else
Resume Exit_UserForm_Initialize
End
End Select

End Sub

shell_l_d
07-09-2010, 08:53 PM
Ok I managed to get around that issue by making the UserForm itself also created using late binding (instead of just the controls on it).

However now I'm presented with another problem...
The combobox never fills with values, if click drop-down arrow, it's all empty, asside from the default value I gave it.

Any ideas please?


'---------------------------------------------------------------------------------------
' Module : Module1
' Purpose : USER FORM CODE
'---------------------------------------------------------------------------------------

Private Const scModuleName As String = "Module1."
Private Const scUserForm As String = "ufrmUpdateData"
Private Const icUserForm As Integer = 3

Public Sub DeleteUserForm()
'---------------------------------------------------------------------------------------
' Procedure : DeleteUserForm
' Purpose : Deletes all userforms on ThisWorkbook
'---------------------------------------------------------------------------------------
On Error Resume Next

Dim oUserForm As Object

' Remove all userforms (only ever want 1 - created on the fly)
ThisWorkbook.Activate
With ActiveWorkbook.VBProject.VBComponents
For i = .Count To 1 Step -1
Set oUserForm = .Item(i)
If oUserForm.Type = icUserForm Then
.Remove oUserForm
End If
Next i
End With

End Sub

Public Sub CreateUserForm()
'---------------------------------------------------------------------------------------
' Procedure : CreateUserForm
' Purpose : Creates a userform & it's controls (labels,combobox,buttons) on the fly using
' late binding so uses correct VB libraries/references.
' Extracts by faq707-5757: http://www.tek-tips.com/faqs.cfm?fid=5757
' Extracts by timbereng (#5): http://www.access-programmers.co.uk/forums/showthread.php?t=164021
'---------------------------------------------------------------------------------------

' For Error Reporting
Dim sErrorDescr As String
Const sErrSource As String = scModuleName & "CreateUserForm"
On Error GoTo Error_In_CreateUserForm

' Late binding (As Object) of controls so uses correct VB library/reference
Dim oUserForm As Object
Dim oLblStartDate As Object, oLblEndDate As Object, oLblFilterOn As Object
Dim oCboFilterOn As Object
Dim oCmdUpdateData As Object, oCmdClose As Object
Dim oDtpStartDate As Object, oDtpEndDate As Object
Dim bHasDtPicker As Boolean

' Create the UserForm
Set oUserForm = ThisWorkbook.VBProject.VBComponents.Add(icUserForm)

' NOTE: .Name may error if userform existed but was deleted & no close or save has taken place since
On Error Resume Next
oUserForm.Name = scUserForm
If Err.Number <> 0 Then
Select Case Err.Number
Case Is = 75, 438, 50135
' 75: Path/File access error
' 438: Object doesn't support this property or method.
' 50135: Application-defined or object-defined error.
MsgBox "Unable to create Update Data Criteria user entry form." _
& vbCrLf & "Please close workbook & re-open."
GoTo Exit_CreateUserForm
Case Else
' An unknown error was encountered, so alert the user
GoTo Error_In_CreateUserForm
End Select
End If
On Error GoTo Error_In_CreateUserForm

With oUserForm
.Properties("Caption") = "Update Data Criteria"
.Properties("Width") = 366.75
.Properties("Height") = 272.25
End With

' Create control objects
Set oLblStartDate = oUserForm.Designer.Controls.Add("Forms.Label.1", "lblStartDate", True)
Set oLblEndDate = oUserForm.Designer.Controls.Add("Forms.Label.1", "lblEndDate", True)
Set oLblFilterOn = oUserForm.Designer.Controls.Add("Forms.Label.1", "lblFilterOn", True)
Set oCboFilterOn = oUserForm.Designer.Controls.Add("Forms.ComboBox.1", "cboFilterOn", True)
Set oCmdUpdateData = oUserForm.Designer.Controls.Add("Forms.CommandButton.1", "cmdUpdateData", True)
Set oCmdClose = oUserForm.Designer.Controls.Add("Forms.CommandButton.1", "cmdClose", True)
On Error Resume Next
Set oDtpStartDate = oUserForm.Designer.Controls.Add("MSComCtl2.DTPicker", "dtpStartDate", True)
Set oDtpEndDate = oUserForm.Designer.Controls.Add("MSComCtl2.DTPicker", "dtpEndDate", True)

' If DTPicker doesnt exist, use text boxes instead
If Err.Number <> 0 Or oDtpStartDate Is Nothing Then
On Error GoTo Error_In_CreateUserForm
bHasDtPicker = False
Set oDtpStartDate = oUserForm.Designer.Controls.Add("Forms.TextBox.1", "dtpStartDate", True)
Set oDtpEndDate = oUserForm.Designer.Controls.Add("Forms.TextBox.1", "dtpEndDate", True)
oDtpStartDate.ControlTipText = "Enter date in format: dd mmm yyyy Eg: 01 Apr 2010"
oDtpEndDate.ControlTipText = "Enter date in format: dd mmm yyyy Eg: 31 Mar 2010"
Else
bHasDtPicker = True
oDtpStartDate.Format = dtpLongDate
oDtpEndDate.Format = dtpLongDate
End If

' Control formatting properties
With oLblStartDate
.Top = 36
.Left = 36
.Height = 22
.Width = 72
.Caption = "Start Date:"
.Font.Size = 12
End With
With oLblEndDate
.Top = 84
.Left = 36
.Height = 22
.Width = 72
.Caption = "End Date:"
.Font.Size = 12
End With
With oLblFilterOn
.Top = 132
.Left = 36
.Height = 22
.Width = 72
.Caption = "Filter On:"
.Font.Size = 12
End With
With oDtpStartDate
.TabIndex = 1
.Top = 36
.Left = 120
.Height = 22
.Width = 210
.Font.Size = 12
End With
With oDtpEndDate
.TabIndex = 2
.Top = 84
.Left = 120
.Height = 22
.Width = 210
.Font.Size = 12
End With
With oCboFilterOn
.TabIndex = 3
.Top = 132
.Left = 120
.Height = 22
.Width = 132
.Font.Size = 12
'.Clear
.AddItem ("CallTime")
.AddItem ("TechComp")
.AddItem ("CloseDate")
.AddItem ("Calc Compl Date")
.ListIndex = 0 ' default value
End With
With oCmdUpdateData
.TabIndex = 4
.Top = 186
.Left = 30
.Height = 36
.Width = 126
.Caption = "Update Data Now"
.Font.Size = 12
End With
With oCmdClose
.TabIndex = 5
.Top = 186
.Left = 198
.Height = 36
.Width = 126
.Caption = "Close"
.Font.Size = 12
End With

' Create Event Handler Code For The Command Buttons
With oUserForm.CodeModule
' cmdClose_Click()
.InsertLines .CountOfLines + 1, "Private Sub cmdClose_Click()"
.InsertLines .CountOfLines + 1, " unload Me"
.InsertLines .CountOfLines + 1, "End Sub"
' cmdUpdateData_Click ()
.InsertLines .CountOfLines + 1, "Private Sub cmdUpdateData_Click()"
.InsertLines .CountOfLines + 1, " MsgBox ""To do stuff here..."" "
.InsertLines .CountOfLines + 1, "End Sub"
End With

' ===== Exit Handler =====
Exit_CreateUserForm:
oUserForm = Nothing
oLblStartDate = Nothing
oLblEndDate = Nothing
oLblFilterOn = Nothing
oCboFilterOn = Nothing
oCmdUpdateData = Nothing
oCmdClose = Nothing
oDtpStartDate = Nothing
oDtpEndDate = Nothing
Exit Sub

' ===== ERROR HANDLER =====
Error_In_CreateUserForm:

With Err
sErrorDescr = "Error '" & .Number & " " & _
.Description & "' occurred in " & sErrSource & _
IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
End With

Select Case MsgBox(sErrorDescr, vbAbortRetryIgnore, "Error in " & sErrSource)
Case vbRetry
Resume
Case vbIgnore
Resume Next
Case Else
Resume Exit_CreateUserForm
End
End Select

End Sub



'---------------------------------------------------------------------------------------
' Module : ThisWorkbook
' Purpose : This Workbook code
'---------------------------------------------------------------------------------------

Private Const scModuleName As String = "ThisWorkbook."

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Call DeleteUserForm
End Sub

Private Sub Workbook_Open()
On Error Resume Next
Call DeleteUserForm
Call CreateUserForm
End Sub

shell_l_d
07-09-2010, 10:29 PM
This works as a workaround... which is part of my original code (manually created userform & initialize created late bound controls) & my new code (late bound userform & controls).

Extracts:

With oCboFilterOn
.TabIndex = 3
.Top = 132
.Left = 120
.Height = 22
.Width = 132
.Font.Size = 12
End With

' Create Event Handler Code For The Command Buttons
With oUserForm.CodeModule
' UserForm_Initialize - populate combobox
.InsertLines .CountOfLines + 1, "Private Sub UserForm_Initialize()"
.InsertLines .CountOfLines + 1, " cboFilterOn.AddItem(""CallTime"") "
.InsertLines .CountOfLines + 1, " cboFilterOn.AddItem(""TechComp"") "
.InsertLines .CountOfLines + 1, " cboFilterOn.AddItem(""CloseDate"") "
.InsertLines .CountOfLines + 1, " cboFilterOn.AddItem(""Calc Compl Date"") "
.InsertLines .CountOfLines + 1, " cboFilterOn.ListIndex = 0 "
.InsertLines .CountOfLines + 1, "End Sub"
End With

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum