Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Макрос для пересохранения файла без открытия этого файла

Автор lovko, 22.11.2015, 11:05

« назад - далее »

lovko

Здравствуйте! В очередной раз требуется помощь в написании макроса. У меня на компьютере на диске С есть папка с файлами 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")?

vikttur

Никак.
В начале работы кода или перед открытием книги отключить обноление экрана и лишние вопросы:
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

После завершения обновления данных - включить.

lovko

Так?

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

vikttur

Отключайте перед For Each, включайте после сохранения данных, перед End Sub

Вы не используете x, зачем x = GetAttr(strPath) And 0?


RAN

#5
На приличных форумах тихо, даже мелкий не шумит.  :P
Делов на рыбью ногу!  ;D
Sub Мяу()
    With CreateObject("Scripting.FileSystemObject")
        .CopyFile "D:\1.xlsm", "D:\1\"
    End With
End Sub