PDA

View Full Version : [SOLVED] excel 2010 stops working when opening a userform



Rob342
09-18-2013, 06:32 AM
Hi
I have a multipage user form that has been working all ok in excel 2003 & 2007 and 9 times out of ten it works ok in excel 2010 but on the odd occasion excel stops working when opening the form, I have now stopped the form opening automatically for a trial too see if it make any difference ???

Has anybody else has these sort of problems
This is the initialise routine for the form on opening


Private Sub UserForm_Initialize()
Dim lngWinState As XlWindowState
Dim ws As Worksheet
Dim IRow As Long
Dim I As Integer
Dim n As Integer
Dim TotNo As Long
Dim SearchRange As Range
Dim FindWhat As Variant
Dim FoundCells As Range
Dim FoundCell As Range
Dim TxtMonth As Date
Dim TxtYear As Date
With Application
.ScreenUpdating = False
lngWinState = .WindowState
.WindowState = xlMaximized
Me.Move 0, 0, .Width, .Height
.WindowState = lngWinState
.ScreenUpdating = True
End With

'// Page 1 login page
Set ws = Worksheets("DLUSR")
Me.CboUser.List = ws.Range("DUsr").Resize(, 2).Value

'// Page 2 Trackers combo's
Me.CboDealer.List = ws.Range("DlrName").Resize(, 2).Value
Me.CboClmType.List = ws.Range("CType").Resize(, 2).Value
Me.CboDClm.List = ws.Range("DInv").Resize(, 2).Value 'Dealer Claimed
Me.TxtStat.Text = "J"
'// Page 4 audit 1
Me.TxtAudUser.Text = Me.TxtAdmin.Text
Me.CboAudDlr.List = ws.Range("DlrName").Resize(, 2).Value
CommandButton12.Enabled = False
CommandButton28.Enabled = False

'// Page 5 Dealers
Me.CboDealerName.List = ws.Range("DlrName").Resize(, 2).Value
'// Page 6 Users
Me.CboUserHub.List = ws.Range("DUsr").Resize(, 2).Value
'// Page 8 reports 1
Me.CboRep1Dlr.List = ws.Range("DlrName").Resize(, 2).Value
Me.CboRep3Dlr.List = ws.Range("DlrName").Resize(, 2).Value
Me.CboRep5User.List = ws.Range("DUsr").Resize(, 2).Value
'// Page 9 Invoice page
CommandButton16.Enabled = False
Me.CboDInv.List = ws.Range("DInv").Resize(, 2).Value
Me.CboDInv.Enabled = False
'// E Mail Page 10 Y or N Combobox
Me.CboEMFlag.List = ws.Range("EMFlag").Resize(, 2).Value

'// Page 12 Audit1P4
Me.CboCAPNo.List = ws.Range("CAPNo").Value

Set ws = Worksheets("AC")
'// Page 7 Job Card Error codes
Me.CboJCErrCode.List = ws.Range("ErrCode").Resize(, 2).Value
'// Page 7 Dept responsible
Me.CboJCResp.List = ws.Range("DeptResp").Resize(, 2).Value
Me.CboAudDErr.List = ws.Range("AudDept").Resize(, 2).Value 'audit departments
'// Page 8
'// Tracker Page 2
IRow = ws.cells(Rows.count, 2).End(xlUp).Offset(1, 0).Row - 1 ' rem col start= B(2)
With Me.LB1
.RowSource = "AC!B2:E" & IRow
.ColumnCount = 2
'.Width = 400 '628.5
.ColumnHeads = True
.ColumnWidths = "50 pt;400pt"
.listindex = 0

End With
'// Make sure the items in listbox are all de-selected
For I = 0 To LB1.ListCount - 1
Me.LB1.Selected(I) = False
Next I
'// Page 4 Audit1
Me.CboAudDept.List = ws.Range("AudDept").Resize(, 2).Value
OptionButton94.Enabled = False
OptionButton95.Enabled = False
Me.TxtAudNotes.Text = ""
Me.TxtAudNotes.Enabled = False
'// Page 12 Audit1P4
Me.CboCAP.List = ws.Range("DeptCAP").Resize(, 2).Value

'// Page 3 Rejected Jobs
Set ws = Worksheets("DBREJ")
Me.CboRejJobNo.List = ws.Range("RejJob").Resize(, 2).Value

'// Hide all the page tabs until a valid user password is entered
'Me.MultiPage1.Page1.Visible = True
Me.MultiPage1.Page2.Visible = False '2nd page = Job card tracker Page 2
Me.MultiPage1.Page3.Visible = False '4th page = rejected jobs back to dealer
Me.MultiPage1.Page4.Visible = False '4th page = Audit 1 Page 4
Me.MultiPage1.Page5.Visible = False '5th page = Dealers Page 5
Me.MultiPage1.Page6.Visible = False '6th page = Users Page 6
Me.MultiPage1.Page7.Visible = False '7th page = Job Card error codes
Me.MultiPage1.Page8.Visible = False '8th page = reports1
Me.MultiPage1.Page9.Visible = False '9th Page invoice details
Me.MultiPage1.Page10.Visible = False '10th Page E Mails details
Me.MultiPage1.Page11.Visible = False '11th page Dams Programme Updates
Me.MultiPage1.page12.Visible = False '12th page audit2 continue sheet audit1
Me.MultiPage1.Value = 0 'sets the 1st tab to login page
'// Hide textboxes until certain fields have been filled
' Page 1 login
Me.CboUser.SetFocus
Me.TxtUserPass.Enabled = False
Application.ShowToolTips = True
With Me.TxtUserPass
.ControlTipText = "Click In The Box & Enter Your Password "
End With
CommandButton1.Enabled = False
'// Page 2 Tracker
'Me.LB1.Enabled = False ' True 'hide it use visible
' Me.CboClmType.Enabled = False
'Me.TxtJobNo.Enabled = False
'OptionButton19.Enabled = False
OptionButton20.Enabled = False
' OptionButton17.Enabled = False
'OptionButton5.Enabled = False
'CommandButton4.Enabled = False
OptionButton86.Enabled = False
DoTheImport.Enabled = False
' Month & Year on Tracker
Me.TxtMonth.Text = Format(Now, "MM") '01 = Jan & so on
Me.TxtYear.Text = Format(Now, "YYYY")

'// Page 3 Rejected job card update
CommandButton9.Enabled = False
CommandButton11.Enabled = False ' delete rej job card buutton
' Page 4 Audit1 Combo for job numbers for selected dealers
Me.CboAudDlr.Enabled = False
Me.CboAudJobNo.Enabled = False

'// Page 7 Audit err codes
OptionButton88.Enabled = False
OptionButton89.Enabled = False

'// Page 9 Invoice page
CommandButton16.Enabled = False
'// Page 11 Dams Programme Updates
'CommandButton22.Enabled = True 'download MDB
'CommandButton23.Enabled = False 'download REJ
'CommandButton24.Enabled = False 'download INV
' CommandButton25.Enabled = False 'Upload REJ
'CommandButton26.Enabled = False 'Upload INV
'CommandButton27.Enabled = False 'Upload MDB
'// Page 12 Audit1p12
CommandButton32.Enabled = False

Set ws = Worksheets("DBINV")
'Call ShowJC_Stat
Me.CboJCStat.List = ws.Range("JobNo").Resize(, 2).Value 'Jobno's for invoice
'Me.CboAudJobNo.List = ws.Range("JobNo").Resize(, 2).Value
'// Show tot of jobs uninvoiced
' Login Page 0
With ws
IRow = ws.cells(Rows.count, 1).End(xlUp).Row - 1
If IRow > 0 Then
Me.TxtShowUnInv.Text = " Reminder You Currenty Have ," & " " & IRow & " " & "Uninvoiced Job Cards Still Outstanding !"
End If
End With

'// Load the login page with no of rejects still open on DBREJ sheet
' Login Page 0
Set ws = Worksheets("DBREJ")
With ws
IRow = ws.cells(Rows.count, 1).End(xlUp).Row - 1
If IRow > 0 Then
Me.TxtShowRejs.Text = " Reminder You Currenty Have ," & " " & IRow & " " & "Rejected To Dealer Job Card's Still Outstanding !"
End If
End With
'// Load the e mail list box show only the various flags
Set ws = Worksheets("EMail")
Me.CboEMailAmd.List = ws.Range("EMail").Resize(, 2).Value

'// List Box to show emails
IRow = ws.cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row - 1 ' rem col start= B(2)
With Me.LBEMail
.RowSource = "EMail!A3:D" & IRow
.ColumnCount = 4
'.Width = 400 '628.5
.ColumnHeads = True
.ColumnWidths = "125pt;200pt;100pt;50pt"
.listindex = 0
'// Make sure the items in listbox are all de-selected
For I = 0 To LBEMail.ListCount - 1
Me.LBEMail.Selected(I) = False
Next I
End With

End Sub

Rob

Jan Karel Pieterse
09-18-2013, 08:40 AM
How is the form opened exactly?

Rob342
09-18-2013, 11:16 AM
Hi Jan
Thanks for the reply
This is the code to open the form, close & hide the sheets as req


Option Explicit
Private Sub Workbook_Open()
'// Hide all the page tabs until a user password is entered
' Load the password form and take it from there
With Application
'disable the ESC key
'.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
'.EnableCancelKey = xlInterrupt
'// Show the password screen depends on login what buttons are enabled

FrmAudit.Show 'vbModal
End With

End Sub

Private Sub UnhideSheets()
'
Dim Sheet As Object
With Application
.ScreenUpdating = False
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVisible
End If
Next
'Rehide the sheets they dont need to see
Sheets("Prompt").Visible = True 'xlSheetVeryHidden 'this is always set to veryhidden
Sheets("MDB").Visible = True 'xlSheetVeryHidden
Sheets("DBREJ").Visible = True 'xlSheetVeryHidden
Sheets("DLUSR").Visible = True 'xlSheetVeryHidden
Sheets("AC").Visible = True 'xlSheetVeryHidden
Sheets("DERR").Visible = True 'xlSheetVeryHidden
Sheets("ERRC").Visible = True 'xlSheetVeryHidden
Sheets("AudHdr").Visible = True 'xlSheetVeryHidden
Sheets("1").Visible = True 'xlSheetVeryHidden
Sheets("2").Visible = True 'xlSheetVeryHidden
Sheets("3").Visible = True 'xlSheetVeryHidden
Sheets("4").Visible = True 'xlSheetVeryHidden
Sheets("5").Visible = True 'xlSheetVeryHidden
Sheets("6").Visible = True 'xlSheetVeryHidden
Sheets("7").Visible = True 'xlSheetVeryHidden
Sheets("8").Visible = True 'xlSheetVeryHidden
Sheets("9").Visible = True 'xlSheetVeryHidden
Sheets("10").Visible = True 'xlSheetVeryHidden
Sheets("11").Visible = True 'xlSheetVeryHidden
Sheets("12").Visible = True 'xlSheetVeryHidden
Sheets("13").Visible = True 'xlSheetVeryHidden
Sheets("14").Visible = True 'xlSheetVeryHidden
Sheets("15").Visible = True 'xlSheetVeryHidden
Sheets("16").Visible = True 'xlSheetVeryHidden
Sheets("17").Visible = True 'xlSheetVeryHidden
Sheets("18").Visible = True 'xlSheetVeryHidden
Sheets("19").Visible = True 'xlSheetVeryHidden
Sheets("20").Visible = True 'xlSheetVeryHidden
Sheets("AudSum").Visible = True 'xlSheetveryHidden
Sheets("EMail").Visible = True 'xlSheetVeryHidden
Sheets("Charts").Visible = True 'xlSheetveryhidden
Sheets("CAP").Visible = True 'xlsheetveryhidden
Sheets("FAS").Visible = True 'xlsheetveryhidden
'Application.GoTo Worksheets(1).[A1], True '< Optional leave cell a32 Menu not protected
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True
.ScreenUpdating = True
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'// Dont close the workbook if the multipage form is still active
' Part code by GTO vbax
Dim wb As Workbook
Dim I As Long
Set wb = ActiveWorkbook
With Application
'Disable the esc key
'.EnableCancelKey = xlDisabled
.ScreenUpdating = False
'Call HideSheets
wb.Save
.ScreenUpdating = True
'Re-enable the esc key
'.EnableCancelKey = xlInterrupt
End With
'
For I = 0 To UserForms.count - 1
If UserForms(I).Name = "FrmAudit" Then
Cancel = True
UserForms(I).Show
Exit For
End If
Next
Application.Quit
End Sub
Private Sub HideSheets()
Dim Sheet As Object '< Includes worksheets and chartsheets
'
Application.ScreenUpdating = False
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A1] below bypass the "Save?" dialog...
If ThisWorkbook.Saved = True Then .[A1] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A1] = "Saved" Then
.[A1].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
Application.ScreenUpdating = True
End Sub



Rob

Dave
09-18-2013, 12:50 PM
I don't like your use of "Sheet" as a variable name ...not sure if XL does? This part doesn't seem right...


Set Sheet = Nothing
ActiveWorkbook.Saved
.ScreenUpdating =True
End With

Should be...

.ScreenUpdating = True
End With
Set Sheet = Nothing
ActiveWorkbook.Saved = True
HTH. Dave

Rob342
09-18-2013, 03:22 PM
Hi Dave
Changed that bit of code & opened the form with open event, worked once ok then excel stopped again ?
Rob

SamT
09-18-2013, 08:47 PM
I suspect this bit
With Application
.ScreenUpdating = False
lngWinState = .WindowState
.WindowState = xlMaximized
Me.Move 0, 0, .Width, .Height
.WindowState = lngWinState
.ScreenUpdating = True
End With
It is saying:


Maximize the Application;
Maximize Form size to full screen, (Excel Window size);
Restore the Application size (sometimes) Which shrinks the Excel Window.


I don't know what happens when the Form is bigger than the Window, If it's even possible.

Another possible cure: Set Top and Left to 1 instead of 0. Set Height and Width to Window H & W - 2


With Application
.ScreenUpdating = False
.WindowState = xlMaximized
Me.Move 1, 1, .UsableWidth - 2, .UsableHeight - 2
.ScreenUpdating = True
End With

Jan Karel Pieterse
09-18-2013, 11:50 PM
I prefer not to have code like that in the Thisworkbook module.
Move all code to subs in a a normal module and call those subs from the events in thisworkbook.
Especially code in workbook_open *sometimes* causes trouble because Excel isn't quite done loading yet when that code is executed.
To avoid that problem, I use the OnTime method to start any code after workbook_Open like so:

Private Sub Workbook_Open()
Application.OnTime Now, "ContinueOpen"
End Sub


Then in the normal sub I have:


Sub ContinueOpen()
Call2Sub1
Call2Sub2
End Sub

Rob342
09-20-2013, 01:05 AM
Sam
Made no difference, just makes the form smaller when initiated.

Jan
I will try that tonight, having taken the Form initialisation out of the workbook open event Excel has not stopped or crashed, it looks like you hit the nail on the head.
I'll leave this thread open & give you an update over the weekend.
Many thanks
Rob

Rob342
10-11-2013, 02:16 PM
Ok Guys, Having tested this over the last 3 weeks or so, have not encountered any problems
Thanks to all for you help
I mark this as solved
Rob

Jan Karel Pieterse
10-12-2013, 07:23 AM
Thank you for letting us know!