Здравствуйте! В очередной раз требуется помощь в написании макроса. У меня на компьютере на диске С есть папка с файлами Excel. Она же продублирована в OneDrive. Эта служба заведена на компьютер. Когда я изменяю файлы на диске С, я вручную переношу их в OneDrive, чтобы затем из OneDrive перенести на домашний компьютер, где я смогу продолжить с ними работу. Тоже самое проделываю дома: измененные файлы переношу в OneDrive, чтобы на работе перенести их на диск С и продолжить с ними работу. OneDrive тем самым является хранилищем последних (самых свежих) по дате изменения файлов. Я подумал: раз так, почему бы не сделать макрос, который сам заменял бы старые файлы на дисках С и рабочего, и домашнего компьютеров более свежим из OneDrive. Создать такой макрос удалось. Однако есть загвоздка. Сначала он открывает файл из OneDrive, и только потом копирует его на диск С. В момент открытия происходит пересчет формул. Так как в OneDrive находятся те же файлы, что и на диске С, формулы ссылаются на эти файлы в OneDrive. Затем файлы пересохраняются на диск С. Проблема в том, что, когда я их открываю с диска С, формулы по-прежнему ссылаются на файлы в OneDrive, а не на аналогичные файлы диска С, как требуется. Если из OneDrive перенести файлы на диск С без их открытия, то формулы работают правильно. Однако такой перенос я пока выполняю вручную, чего и хотелось бы избежать. Вот мой вопрос: как выполнить пересохранение файла без его открытия? Макрос, уточню, помещен в персональную книгу макросов.
Сейчас макрос выглядит так (на примере одного файла):
Dim twb As Workbook
Set twb = ThisWorkbook
For Each Workbook In Workbooks
If Workbook.Name <> twb.Name Then
Workbook.Close 0
End If
Next
Application.Workbooks.Open ("c:\Excel\7111978.xlsm")
Dim x As String
strPath = "C:\Users\Users\OneDrive\Excel"
On Error Resume Next
x = GetAttr(strPath) And 0
If Err = 0 Then
FileNameXls = strPath & "\" & "7111978" & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
ActiveWorkbook.Save
ActiveWindow.Close
End If
End Sub
Кнопка оформления кода в сообщении - # [МОДЕРАТОР]
Как избежать строки: Application.Workbooks.Open ("c:\Excel\7111978.xlsm")?
Никак.
В начале работы кода или перед открытием книги отключить обноление экрана и лишние вопросы:
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
После завершения обновления данных - включить.
Так?
Dim twb As Workbook
Set twb = ThisWorkbook
For Each Workbook In Workbooks
If Workbook.Name <> twb.Name Then
Workbook.Close 0
End If
Next
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Application.Workbooks.Open ("c:\Excel\7111978.xlsm")
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
Dim x As String
strPath = "C:\Users\Users\OneDrive\Excel"
On Error Resume Next
x = GetAttr(strPath) And 0
If Err = 0 Then
FileNameXls = strPath & "\" & "7111978" & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
ActiveWorkbook.Save
ActiveWindow.Close
End If
End Sub
Отключайте перед For Each, включайте после сохранения данных, перед End Sub
Вы не используете x, зачем x = GetAttr(strPath) And 0?
Спасибо!
На приличных форумах тихо, даже мелкий не шумит. :P
Делов на рыбью ногу! ;D
Sub Мяу()
With CreateObject("Scripting.FileSystemObject")
.CopyFile "D:\1.xlsm", "D:\1\"
End With
End Sub
Ок, спасибо!