我有一本工作簿用于捕获有点奇怪的新项目构思。当用户单击“添加项目”按钮时,会出现一个用户表单,询问项目信息,然后CreateNewIdea过程会复制模板工作表并使用userform中的数据填充它(此工作表在下面的代码中是wsIdea)。该过程还在“摘要”工作表中创建一个新的条目/行,添加指向项目唯一工作表的链接,并输入公式以从项目的唯一工作表中查找数据。
“摘要”工作表(代码中的wsSummary)充当提交的每个项目的伪数据库。此工作表受到保护,因此用户无法编辑摘要中的值;他们必须去项目的具体工作表才能做到这一点。
我遇到的问题是摘要表按预期工作 - 它在运行时取消保护,然后在程序结束时重新保护 - 但由于某种原因,项目的特定工作表也是“代理” “受保护。我说“代理”是因为一旦用户转到工作簿中的任何其他工作表并返回,他们就能像平常一样使用它。它只是在程序之后立即显示出对用户的保护。
以下是主要程序的代码:
Sub CreateNewIdea(strIdeaTitle As String, strIdeaDescription As String, strDivSection As String, strProjectType As String, strSubmittedBy As String, datCurrentDate As Date)
'Disable screen updating
Application.ScreenUpdating = False
'Unprotect worksheets
Call UnprotectWorksheet(wsSummary, "costmanagement")
Call UnprotectWorksheet(wsRemoved, "costmanagement")
'Debug MsgBox
Dim strSubmission As String
strSubmission = "A new cost reduction idea has been submitted to the idea hopper--details below." & vbNewLine & "--------------------" & vbNewLine & vbNewLine & "Title: " & strIdeaTitle & vbNewLine & vbNewLine & "Description: " & strIdeaDescription & vbNewLine & vbNewLine & "Div/Section: " & strDivSection & vbNewLine & vbNewLine & "Type: " & strProjectType & vbNewLine & vbNewLine & "Submitted By: " & strSubmittedBy & vbNewLine & vbNewLine & "Date Submitted: " & datCurrentDate
'MsgBox strSubmission
'Get project ID
lngNumIdeas = wsSettings.Range("B8").Value
lngNextID = wsSettings.Range("B9").Value
lngCurrentYear = Year(datCurrentDate)
'Copy Template
Dim wsIdea As Worksheet
Dim strShortTitle As String
strShortTitle = Left("" & lngNextID & "_" & strIdeaTitle, 30)
strShortTitle = Replace(Replace(Replace(Replace(Replace(Replace(Replace(strShortTitle, ":", ""), "/", ""), "\", ""), "?", ""), "*", ""), "[", ""), "]", "") 'Cleanse short title to remove invalid characters
wsTemplate.Visible = xlSheetVisible
wsTemplate.Copy after:=wsHopperStatistics
Set wsIdea = ActiveSheet
wsIdea.Name = strShortTitle
wsTemplate.Visible = xlSheetHidden
'Enter preliminary data
wsIdea.Range("D3").Value = strIdeaTitle
wsIdea.Range("D5").Value = strSubmittedBy
wsIdea.Range("D6").Value = strDivSection
wsIdea.Range("D7").Value = strProjectType
wsIdea.Range("D8").Value = strIdeaDescription
'Set up named range (=strShortTitle)
Dim strNamedRange
strNamedRange = "Idea" & lngNextID
wbHopper.Names.Add Name:=strNamedRange, RefersTo:="='" & wsIdea.Name & "'!$A$1:$AG$60"
'Clear filter from summary sheets
If (wsSummary.AutoFilterMode And wsSummary.FilterMode) Or wsSummary.FilterMode Then
wsSummary.ShowAllData
End If
If (wsRemoved.AutoFilterMode And wsRemoved.FilterMode) Or wsRemoved.FilterMode Then
wsRemoved.ShowAllData
End If
'Enter formulas into summary sheet
Dim lngFirstIdeaRow As Long
Dim lngCurrentIdeaRow As Long
lngFirstIdeaRow = 6
lngCurrentIdeaRow = wsSummary.UsedRange.Rows.Count + 1
wsSummary.Range("A" & lngCurrentIdeaRow).Hyperlinks.Add Anchor:=wsSummary.Range("A" & lngCurrentIdeaRow), Address:="", SubAddress:=strNamedRange, TextToDisplay:="Link"
'<--more formulas go here-->
'Update subtotal formulas
wsSummary.Range("U3").Formula = "=SUBTOTAL(9,U" & lngFirstIdeaRow & ":U" & lngCurrentIdeaRow & ")"
'<--more formulas go here-->
'Update Project List Named Range
wbHopper.Names.Add Name:="IdeaTitles", RefersTo:="=OFFSET('" & wsSummary.Name & "'!$C$6,0,0," & lngCurrentIdeaRow - lngFirstIdeaRow + 1 & ",1)"
'Update Settings Worksheet
wsSettings.Range("B8").Value = wsSettings.Range("B8").Value + 1
wsSettings.Range("B9").Value = wsSettings.Range("B9").Value + 1
'Send Email notifications
If wsSettings.Range("B2").Value = "Yes" Then
If wsSettings.Range("B3").Value <> "" And InStr(1, wsSettings.Range("B3").Text, "@") > 0 Then
Call SendLotusNotesEmail("New Cost Reduction Idea Submitted", "", wsSettings.Range("B3").Text, strSubmission, False)
End If
If wsSettings.Range("B4").Value <> "" And InStr(1, wsSettings.Range("B4").Text, "@") > 0 Then
Call SendLotusNotesEmail("New Cost Reduction Idea Submitted", "", wsSettings.Range("B4").Text, strSubmission, False)
End If
End If
'Update Hopper Statistics
Call RefreshHopperStatistics
'Protect worksheets
Call ProtectWorksheet(wsSummary, "costmanagement")
Call ProtectWorksheet(wsRemoved, "costmanagement")
'Re-enable screen updating
Application.ScreenUpdating = True
'Go to Summary Sheet then back to wsIdea (fix for protected sheet bug)
wsSummary.Activate
wsIdea.Activate
'Display confirmation message
If wsSettings.Range("B2").Value = "Yes" Then
MsgBox "Your idea has been submitted and it's own RORD sheet has been created in this workbook. Please continue to update this idea's RORD sheet as your idea becomes more mature." & vbNewLine & vbNewLine & "An email has been submitted to your Cost Management team for follow-up. Please contact them with any questions / comments / concerns."
Else
MsgBox "Your idea has been submitted and it's own RORD sheet has been created in this workbook. Please continue to update this idea's RORD sheet as your idea becomes more mature." & vbNewLine & vbNewLine & "Please contact your cost management team with any questions / comments / concerns."
End If
End Sub
您可能已经注意到一些自定义函数的调用:UnprotectWorksheet()和ProtectWorksheet()。他们在这里:
Function UnprotectWorksheet(wsWorksheet As Worksheet, strPassword As String)
'Description: Unprotects the specified worksheet
'Syntax: Call UnprotectWorksheet(wsWorksheet, Password)
wsWorksheet.Unprotect Password:=strPassword
End Function
Function ProtectWorksheet(wsWorksheet As Worksheet, strPassword As String)
'Description: Protects the specified worksheet
'Syntax Call ProtectWorksheet(wsWorksheet, Password)
wsWorksheet.Protect Password:=strPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Function
我不明白的是,我根本没有保护或取消对wsIdea的保护。我认为通过代码切换到几张纸可以解决问题,但它仍然存在。
知道这里有什么用吗?提前感谢任何建议!