0

直到最近，我的 VBA 用户表单都没有问题，但基于某些代码或代码的绝对长度导致 Excel 在尝试运行时崩溃。此表格用于从预算所有者那里收集信息，我们需要提供更多信息，而不仅仅是财务信息，我们希望他们不必进行任何重大计算。最近，当我启动代码时，工作簿变白并说 Excel 遇到错误并让我选择恢复文件。（不确定这是否相关，但似乎我的代码可能会阻止用户在 excel 应用程序中点击 x，也不允许他们使用另存为按钮。当他们点击时没有任何反应）

我已经在最旧的文件上成功地尝试了以前的版本，这些文件不包含很多代码行，没有关闭用户表单功能，也没有保存用户表单功能。如果我在运行代码之前单步执行或打开 Visual Basic 窗口，我不会遇到任何问题。如果我在打开工作簿后立即将文件保存为不同的文件，那么它每次都有效。

Sub Call_Userform()
'Unhide All sheets    
Call unhidesheets
Sheets("Headcount").Select

'Opens the Userform
Test.Show
End Sub
_________________________________________________________
Sub unhidesheets()
'Variables
Dim ws As Worksheet
'Unhide sheets
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws
Application.ScreenUpdating = True
End Sub
__________________________________________________________
Private Sub UserForm_Initialize()
'Variables
Dim ws As Worksheet
Set ws = Worksheets("Data")

'Department specific accounts allowed
If ws.Range("B1").Value = "625 - Bedre Manufacturing" Then
   Me.MultiPage1.Pages(8).Visible = True 'Product Development
ElseIf ws.Range("D1").Value = "217 - Business Support Center" Then
   Me.MultiPage1.Pages(8).Visible = True 'Product Development
ElseIf ws.Range("D1").Value = "216 - Health Branding" Then
   Me.MultiPage1.Pages(8).Visible = True 'Product Development
ElseIf ws.Range("D1").Value = "964 - Outreach" Then
   Me.MultiPage1.Pages(8).Visible = True 'Product Development
ElseIf ws.Range("B1").Value = "978 - Tribal Health" Then
   Me.Trvlexp.Visible = True 'Travel Expense
   Me.trvlexpenselbl.Visible = True 'Travel Expense label
ElseIf ws.Range("D1").Value = "103 - Deputy Secretary of Commerce" Then
   Me.Trvlexp.Visible = True 'Travel Expense
   Me.trvlexpenselbl.Visible = True 'Travel Expense label
Else
   Me.MultiPage1.Pages(8).Visible = False 'Product Development
   Me.Trvlexp.Visible = False 'Travel Expense
   Me.trvlexpenselbl.Visible = False 'Travel Expense label
End If

'Populate lists with present data
If ws.Range("J2") > 0 Then
    List7005.RowSource = "acct7005"
End If
If ws.Range("J3") > 0 Then
    Listtrvl.RowSource = "accttrvl"
End If
    If ws.Range("J4") > 0 Then
    List7120_1.RowSource = "VehTag"
End If
If ws.Range("J5") > 0 Then
    List7120.RowSource = "acct7120"
End If
If ws.Range("J6") > 0 Then
    List7200.RowSource = "acct7200"
End If
If ws.Range("J7") > 0 Then
    List7230.RowSource = "acct7230"
End If
If ws.Range("J8") > 0 Then
    List7270.RowSource = "acct7270"
End If
If ws.Range("J9") > 0 Then
    List7330.RowSource = "acct7330"
End If
If ws.Range("J10") > 0 Then
    List7335.RowSource = "acct7335"
End If
If ws.Range("J11") > 0 Then
    Costs7510.RowSource = "Phonecosts"
End If
If ws.Range("J12") > 0 Then
    List7620.RowSource = "acct7620"
End If
If ws.Range("J13") > 0 Then
   List7640.RowSource = "acct7640"
End If
If ws.Range("J14") > 0 Then
    List7670.RowSource = "acct7670"
End If
If ws.Range("J15") > 0 Then
    List7710.RowSource = "acct7710"
End If
If ws.Range("J16") > 0 Then
    List7780.RowSource = "acct7780"
End If
If ws.Range("J17") > 0 Then
    List7790.RowSource = "acct7790"
End If
If ws.Range("J23") > 0 Then
    List7790_1.RowSource = "Vehlease"
End If
If ws.Range("J18") > 0 Then
    List7880.RowSource = "acct7880"
End If
If ws.Range("J19") > 0 Then
    List2000.RowSource = "acct2000"
End If

'Bring in last records
If Worksheets("Headcount").Range("B1").Value = "" Then
Else
Me.cb_bus = Worksheets("Headcount").Range("B1").Value
Me.cb_dept = Worksheets("Headcount").Range("D1").Value
'Report Kronos date
Me.tb_test.Value = Worksheets("Headcount").Range("I1").Value
End If

Application.ScreenUpdating = True

End Sub    
_________________________________________________________________
Private Sub cbsave_Click()
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.xlsm), *.xlsm")
If fileSaveName <> False Then
ActiveWorkbook.SaveAs _
    Filename:=fileSaveName, _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If

End Sub
__________________________________________________________________
Private Sub closeform_Click()
'Variables
 Dim ws As Worksheet
'Hide sheets
For Each ws In ActiveWorkbook.Worksheets
    ws.Visible = xlSheetHidden
    Sheets("Start and Instructions").Visible = True
Next ws
If Sheets("Start and Instructions").Range("CA1").Value = "Complete" Then
    Sheets("TM1 Upload").Visible = True
    Sheets("CapEx").Visible = True
    Sheets("TM1 Upload").Select
End If

'Close User Form
Hide
End Sub
4

0 回答 0