У меня есть шаблон Excel, который рекомендуется открывать только для чтения при открытии для пользователей (у меня есть пароль для открытия файла, чтобы иметь возможность изменять / редактировать файл).У меня есть скрипт VBA, который сохраняет открытый файл только для чтения.
Когда я сохраняю файл обычным способом (меню> сохранить как> выберите файл> сохранить), Excel возвращает сообщение о том, что файл не может быть сохранен, потому чтоон открывается как доступный только для чтения.
Когда я использую скрипт, всплывающее окно показывает мне нужный каталог с правильным именем файла, и сохранение возможно (так что открыт как доступный только для чтения, он все еще может быть сохранен сто же имя файла).Нет ошибок вообще.
Но когда я сейчас смотрю в каталоге, большинство файлов, которые я обновил и сохранил, не имеют обновленных «дата и время последнего изменения».И когда я открываю файл, все внесенные мной изменения больше не находятся в файле.
Возможно ли, что VBA говорит, что он сохранил файл с тем же именем файла, хотя файл был открыт только для чтения, но на самом деле ничего не сохранил?
вот код save-as:
Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant
Windows(mytemplate).Activate
On Error GoTo Err_
MsgBox ("Bezig met vernieuwen")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Call SheetOpschonen
Call datawissen
Call dataplaatsen
Call kolomtitels
Call toevoegen
Call maaktabel
Call refreshpivots
workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:="M:\Commercie\Marktdata\IRi\Segment ontwikkeling\")
MsgBox workbook_Name
If workbook_Name <> False Then
ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50
End If
Exit_:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
Err_:
Call MsgBox(Err.Number & vbCrLf & Err.Description)
Resume Exit_
Application.Calculation = xlCalculationAutomatic
End Sub
вроде бы работает, но как я выяснил, он не работает когда файлоткрывается как доступный только для чтения, хотя мне кажется, что файл сохранен и может перезаписать исходный файл при открытии только для чтения.
обновление 2019-04-11 10:00 утра:
по предложению ZACK я изменил свое сохранение как код так:
Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant
Windows(mytemplate).Activate
On Error GoTo Err_
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Call SheetOpschonen
Call datawissen
Call dataplaatsen
Call kolomtitels
Call toevoegen
Call maaktabel
Call refreshpivots
If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:="M:\Commercie\Marktdata\IRi\Segment ontwikkeling\")
If workbook_Name <> False Then ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
Exit_:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
Err_:
Call MsgBox(Err.Number & vbCrLf & Err.Description)
Resume Exit_
Application.Calculation = xlCalculationAutomatic
End Sub
, открывая файл только для чтения и сохраняя его при перезаписи исходного файла только для чтения.За исключением того, что я знаю, нужно снова ввести имя файла.Хотя, если раньше использовалось исходное имя файла, на всплывающем экране сохранения как больше не отображается имя файла.
![save-as-popup.png](https://i.postimg.cc/zfd04trK/save-as-popup.png)
обновление 2 2019-04-11 10:31 AM:
У меня были некоторые дополнительные "сохранить как код »для получения правильного имени файла, которое я использовал раньше (было в оригинальном посте).Я добавил этот код в свой основной макрос и проверил, работает ли он.Теперь доступ к файлу изменен правильно, всплывающее окно сохранения как показывает правильное имя файла в правильном каталоге, и файл сохраняется.
Вывод: дело закрыто, вопрос ответил!
Вот как это работает (для меня):
Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant
Dim workbookdirectory As String
Dim activewb As String
Windows(mytemplate).Activate
On Error GoTo Err_
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Call SheetOpschonen
Call datawissen
Call dataplaatsen
Call kolomtitels
Call toevoegen
Call maaktabel
Call refreshpivots
If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
activewb = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
workbookdirectory = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\"
workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:=workbookdirectory & activewb)
If workbook_Name <> False Then ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
Exit_:
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
Err_:
Call MsgBox(Err.Number & vbCrLf & Err.Description)
Resume Exit_
Application.Calculation = xlCalculationAutomatic
End Sub