Только для чтения открытый файл Excel сохраняется с VBA, но не сохраняется вообще? - PullRequest
0 голосов
/ 10 апреля 2019

У меня есть шаблон 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

обновление 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

1 Ответ

1 голос
/ 10 апреля 2019

Еще одно решение, которое вы можете попробовать, это то, о чем говорил Зак.Это изменит доступ к активной книге, так что вы сможете запустить свой код, а затем изменить его обратно только для чтения.

Sub saveas()
Dim workbook_Name As Variant
Dim location As String
Dim workbookdirectory As String
Dim activewb As String
    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:=activewb, FileFormat:=50

    ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
End Sub
...