VBA – 保存无法更改内容的工作簿

我有一个macros在VBA中创build工作簿的副本。 我想要这个副本“只读”，但属性ReadOnly := True工作。 你可以帮我吗 ？ 代码如下：

第一个macros：

 Sub SaveXL() Dim Nom2 As String Dim Jour2 As String Dim FPath2 As String Jour2 = Format(Now(), "yyyymmdd - h\hmm") Nom2 = Jour2 & " Pricelist" FPath2 = Sheets("PARAM").Range("B33").Value On Error GoTo fin4 fichier = Application.GetSaveAsFilename(FPath2 & Nom2, "Fichiers Excel (*.xls), *.xls") If fichier <> "Faux" Then ActiveWorkbook.SaveCopyAs fichier VBA.SetAttr fichier, vbReadOnly Test GetAName(fichier) Else MsgBox "Le fichier n'a pas été enregistré" End If Exit Sub fin4: MsgBox "La création de l'excel a échoué" End Sub 

第二 ：

 Sub Test(targetWorkbookName As String) Dim F As Integer, C As Integer, derniereligne Dim targetWorkbook As Workbook On Error Resume Next Set targetWorkbook = Workbooks(targetWorkbookName) On Error GoTo 0 If (targetWorkbook Is Nothing) Then _ Set targetWorkbook = Workbooks.Open(Filename := targetWorkbookName, ReadOnly := True) For F = 1 To Sheets.Count ActiveSheet.Select For C = 15 To 2 Step -1 ActiveSheet.Columns(C).Select Selection.End(xlDown).Select derniereligne = ActiveCell.Row If ActiveSheet.Columns(C).Hidden = True Then ActiveSheet.Columns(C).Delete End If Next C Next F Application.DisplayAlerts = False Sheets("PARAM").Delete ActiveWorkbook.ActiveSheet.Shapes.Range(Array("Button 2")).Select Selection.Delete ActiveWorkbook.ActiveSheet.Shapes.Range(Array("Button 9")).Select Selection.Delete targetWorkbook.SaveAs Filename:=targetWorkbookName, FileFormat:=xlOpenXMLWorkbook End Sub 

谢谢 ！

Answer 1

如果要使工作簿不可保存 ，则可以执行以下操作：

在ThisWorkbook模块中使用：

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Cancel = True End Sub 

然后到达立即窗口（按下Ctrl + G ）并input：

Application.EnableEvents = False – 按Enter键
ThisWorkbook.Save – 按Enter键
Application.EnableEvents = True – 按Enter键

现在，当用户试图保存工作簿时，它将简单地取消保存，这意味着数据不能被永久覆盖。

Answer 2

 ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly 

Answer 3

只读是不受Excel控制的文件系统权限

build议使用只读的Excel控制版本，并提示用户以只读方式打开（但不能select）。

要将工作簿的副本保存为只读，build议您需要： –

1. 使用SaveCopyAs保存副本
2. 打开副本
3. 将属性ReadOnlyRecommended设置为true，使用SaveAs保存副本
4. 删除第一条指令中的前一个副本

下面是一个小例子： – Public Sub Make_Copy_ReadOnlyRec（）Dim WkBk As Excel.Workbook

 'Using SaveCopyAs ThisWorkbook.SaveCopyAs Environ("UserProfile") & "\Desktop\Temp.xlsm" 'Open the copy Set WkBk = Application.Workbooks.Open(Environ("UserProfile") & "\Desktop\Temp.xlsm") 'Use save as to make it read only recommended WkBk.SaveAs Environ("UserProfile") & "\Desktop\Sample.xlsm", XlFileFormat.xlOpenXMLWorkbookMacroEnabled, , , True 'Close the now read only recommended copy WkBk.Close Set WkBk = Nothing 'Delete the original copy Kill Environ("UserProfile") & "\Desktop\Temp.xlsm" End Sub