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
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