Question

我有一个我在Excel 2003中编写的应用程序，我最近已升级到Excel 2013.在workbook_open事件中，我将工作簿设置为只读ActiveWorkbook.ChangeFileAccess xlReadOnly并使用了{{1按钮在read \ write和read之间切换。在Excel 2003中切换文件模式时，工作簿将按预期切换。当我在2013年以 .xlsm 运行它时，在切换文件状态后调用Toggle Read Only事件并且它再次变为只读。

Workbook_Open

Answer 1

可以在不将FileAccess更改为只读的情况下实现您所获得的结果。您可以使用Workbook_BeforeSave和Workbook_Beforeclose事件来控制一个人保存工作簿的能力。我在下面提供了一个完整的代码示例，我相信它会满足您的需求。您可以使用切换按钮或您选择运行subMakeItSaveable和subMakeItUnSaveable的任何方法，或者您可以在单个例程中实现该功能。 funUpdateCustomDocumentProperty函数将布尔值写入工作簿自定义属性以切换保存工作表的功能。请注意，除了提供存储不在代码或工作表中的值的位置之外，此自定义属性不会执行任何操作。这提供了一种方法，可以在代码未运行时保存代码所需的数据。

我使用的代码如下：

    Private Sub Workbook_BeforeClose(Cancel As Boolean)
      ThisWorkbook.Saved = True
    End Sub

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      If ThisWorkbook.CustomDocumentProperties("SaveMyChanges").Value Then
        SaveAsUI = True
        Cancel = False
      Else
        SaveAsUI = False
        Cancel = True
        myTestValue = MsgBox("Read Only Workbook. Save Not Allowed.",         vbInformation, "Operation Aborted")
      End If
    End Sub

    Private Sub Workbook_Open()
      myTestValue = funUpdateCustomDocumentProperty("SaveMyChanges", False, msoPropertyTypeBoolean)
    End Sub

    Public Function funUpdateCustomDocumentProperty(strPropertyName As String, _
     varValue As Variant, docType As Office.MsoDocProperties) As Boolean
    'Function returns true if custom property was added, false if it already exists
    'Originally a sub built by Peter Albert
    'http://stackoverflow.com/users/1867581/peter-albert

      On Error Resume Next
      funUpdateCustomDocumentProperty = False
      ThisWorkbook.CustomDocumentProperties(strPropertyName).Value _
    = varValue

      If Err.Number > 0 Then

        ThisWorkbook.CustomDocumentProperties.Add _
          Name:=strPropertyName, _
          LinkToContent:=False, _
          Type:=docType, _
          Value:=varValue
        funUpdateCustomDocumentProperty = True
      End If
    End Function


    Public Sub subMakeItSaveable()
      myTestValue = funUpdateCustomDocumentProperty("SaveMyChanges", True, msoPropertyTypeBoolean)
    End Sub


    Public Sub subMakeItUnSaveable()
      myTestValue = funUpdateCustomDocumentProperty("SaveMyChanges", False, msoPropertyTypeBoolean)
    End Sub

Excel 2013切换只读

1 个答案: