Новости:

Прикрепить к сообщению можно только файлы xls, gif, jpg, rar, zip,7z, bas, frm, cls, doc размером до 150 Кб.

Главное меню

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

Автор 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