新工作表在创建后“显示”受到保护,直到我离开并返回

时间:2016-08-02 17:56:13

标签: excel vba excel-vba

我有一本工作簿用于捕获有点奇怪的新项目构思。当用户单击“添加项目”按钮时,会出现一个用户表单,询问项目信息,然后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的保护。我认为通过代码切换到几张纸可以解决问题,但它仍然存在。

知道这里有什么用吗?提前感谢任何建议!

0 个答案:

没有答案