Question

我有一个excel工作簿，我希望只有拥有密码的人才能覆盖现有的Excel工作簿文件。

所以正常＆＃34;保存＆＃34;按钮不起作用，没有该密码的人只能＆＃34;另存为...＆＃34;文件。

所以，我正在寻找一个可以在ThisWorkbook

中为我做的VBA代码

聚苯乙烯。如果密码不安全，我希望没有人覆盖现有文件。

我是VBA的初学者，但这是我所得到的（在其他人的帮助下）

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Static OKGo As Boolean
If Not OKGo Then
    If SaveAsUI Then
        Cancel = True
        OKGo = True
        Application.Dialogs(xlDialogSaveAs).Show NextName
    End If
End If
OKGo = False
End Sub

Function NextName(Optional ByVal ThisName As String) As String
Const SplitChr As String = "_"
Dim ThisIndex As Long

If ThisName = vbNullString Then ThisName = ThisWorkbook.Name
    ThisName = Split(ThisName, ".")(0)
    NextName = Split(ThisName, SplitChr)(0)
    ThisIndex = Val(Split(ThisName & SplitChr & "1", SplitChr)(1))
    NextName = NextName & "_" & (ThisIndex + 1)
End Function

上面的代码以任何可能的方式阻止了保存。那不是我想要的。代码必须阻止保存现有文件/覆盖。

或者可能是这样的？

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim myFullPath As String
Dim newPath As String
Dim FileName As String

With Sheets("Beginblad")
    FileName = .Range("P11")
End With

If (ThisWorkbook.Name = FileName) And Not (OKFlag) Then
    ' this is the original workbok
    If SaveAsUI Then
        Cancel = True

        myFullPath = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
        newPath = Application.GetSaveAsFilename(myFullPath)

        If newPath = "False" Then Exit Sub: ' canceled
        If LCase(myFullPath) = LCase(newPath) Then
             MsgBox "You must change the name or location of this file"
        Else
            MsgBox "all good"
            OKFlag = True
            MsgBox myFullPath & vbCr & newPath
            ThisWorkbook.SaveAs newPath
        End If
    Else
        MsgBox "You cannot save this workbook unless you change its name"
        Cancel = True
    End If

End If
OKFlag = False

End Sub

如果文件已保存，以下代码会向我发出信号。

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
   If Success = False Then MsgBox "Not Saved!", vbOKOnly + vbCritical
   If Success = True Then MsgBox "Saved", vbOKOnly + vbInformation
End Sub

Excel 2010 |防止人们保存/覆盖现有文件VBA

0 个答案: