5

我创建了一个包含许多 .xls 和 .xlsm 工作表的文件夹，该文件夹将分发给公司中的许多人，为了不改变文件夹中工作表的完整性，我想禁用在此文件夹中保存任何文件，所有保存的填充都必须“另存为”在与名为 project.Here 的文件夹不同的位置。这是迄今为止发现的内容。

干杯

  Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     '  Following line will prevent all saving
    Cancel = True
     '  Following line displays the Save As Dialog box
    If SaveAsUI Then SaveAsUI = True
     ' How do I forbid the folders path ???
  End Sub
4

2 回答 2

3

我想出了一种方法。也许有人可以给你一个更好的答案。

它会将文件保存到您的默认位置，该位置设置为C:\MyFiles，并在之后显示一个带有文件路径的 MessageBox。

仅当您不想询问用户将文件保存在哪里并将其保存在静态位置然后通知他/她文件保存到的位置时才使用此代码。

下面的代码在这里（ThisWorkbook 对象模块）

在此处输入图像描述

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

    If SaveAsUI Then
        Cancel = True
    Else

        Dim path As String
        path = "C:\MyFiles\"

        If Len(dir(path, vbDirectory)) = 0 Then
           MkDir path
        End If

        Me.SaveAs Filename:=path & Me.Name, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        MsgBox "This file has been saved in " & path & Me.Name
        Cancel = True
        Exit Sub
    End If
End Sub

更新！

如果您的所有用户都在 Windows 7 上，那么您可以将路径更改为

path = "C:\Users\" & Environ$("username") & "\Desktop\"

无论用户名如何，这都会转到每个用户的桌面。该Environ$("username")函数返回当前登录的用户名。

于 2013-09-19T13:51:06.387 回答
0

无论 Windows 操作系统版本如何，此版本都会保存到用户桌面

它还禁用Events，以便代码不会递归调用自身。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Object
Set ws = CreateObject("WScript.Shell")

If ThisWorkbook.Saved Then
    Application.EnableEvents = False
    ThisWorkbook.SaveAs ws.specialfolders("Desktop") & "\" & ThisWorkbook.Name
    MsgBox ThisWorkbook.Name & " saved to " & ws.specialfolders("Desktop")
    Application.EnableEvents = True
Else
    MsgBox "workbook has not been saved before", vbCritical
    Cancel = True
End If

End Sub
于 2015-01-01T11:54:50.147 回答