Макрос для закрытия всех книг в excel - Word и Excel - помощь в работе с программами

Как закрыть сразу все книги

На чтение 2 мин. Просмотров 1.5k.

Что делает макрос: Данный макрос позволяет закрыть все открытые рабочие книги одновременно.

Содержание

Как макрос работает
Код макроса
Как работает этот код
Как использовать

Как макрос работает

В этом макросе, коллекция Workbooks перебирает все открытые рабочие книги. По мере того, как макрос проходит через каждую книгу, он сохраняет и закрывает их.

Код макроса

Sub ZakritVseKnigi()
'Шаг 1: Объявляем переменные
Dim wb As Workbook
'Шаг 2: Перебираем все открытые книги
For Each wb In Workbooks
'Шаг 3: Закрываем
wb.Close 
'Шаг 4: Сохраняем изменения
SaveChanges:=True
Next wb
End Sub

Как работает этот код

Объявляем переменную, которая представляет собой объект книга. Это позволит перебирать все открытые книги.
С помощью цикла просто проходит через все открытые книги.
Закрываем книгу (Excel затем выдаст сообщение с предложением сохранить изменения).
Сохраняем изменения. Если Вы не хотите, чтобы их сохраняли, нужно изменить аргумент Savechanges значение с True на false.

Как использовать

Лучшее место, чтобы сохранить этот макрос — это ваша книга личных макросов. Таким образом, макрос всегда будет доступен для вас. Книга личных макросов загружается при запуске Excel. В окне VBE проекта, он назван personal.xlsb.

Активируйте редактор Visual Basic, нажав ALT + F11 на клавиатуре.
Щелкните правой кнопкой мыши personal.xlb в окне Project.
Выберите Insert➜Module.
Введите или вставьте код во вновь созданном модуле.

Если вы не видите personal.xlb в окне проекта, он еще не существует. Вы должны записать макрос, используя книгу личных макросов в качестве конечного пункта.

Чтобы записать макрос в личной книге макросов, выберите пункт: Личная книга макросов в диалоговом окне записи макроса перед началом записи. Просто записать пару кликов, а затем остановить запись. Вы можете сбросить записанный макрос и заменить его с этим.

Источник

Эти макросы помогут вам закрыть все открытые файлы Excel, оставив лишь текущий файл.

Выбирайте любой из них — они мало чем отличаются.

Первый оставляет открытой только активную книгу, независимо от того, из какого файла запущен этот макрос:

Sub CloseAllWorkbooks1()
    ' закрываем все книги, кроме текущей (активной)
    Dim wb As Workbook: Application.ScreenUpdating = False
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ActiveWorkbook Then    ' если это не этот файл
            If wb.Windows(1).Visible Then wb.Close    ' закрываем его
        End If
    Next wb
End Sub

Второй макрос оставляет открытой только ту книгу, из которой запущен этот самый макрос, независимо от того, какая книга активна на момент запуска:

Sub CloseAllWorkbooks2()
    ' закрываем все книги, кроме той, из которой запущен макрос
    Dim wb As Workbook: Application.ScreenUpdating = False
    For Each wb In Workbooks    ' перебираем все открытые книги
        If Not wb Is ThisWorkbook Then If wb.Windows(1).Visible Then wb.Close
    Next wb
End Sub

Третья версия макроса отличается от первой лишь тем, что все файлы закрываются с сохранением изменений:
(первый макрос в этом случае выдаёт диалоговое окно — сохранять файл, или нет)

Sub CloseAllWorkbooks3()
    ' закрываем все книги, кроме текущей (активной), С СОХРАНЕНИЕМ изменений
    Dim wb As Workbook: Application.ScreenUpdating = False
    For Each wb In Workbooks    ' перебираем все открытые книги
        If wb.Windows(1).Visible = True And (Not wb Is ActiveWorkbook) Then
            ' закрываем с сохранением только изменённые файлы
            wb.Close (Not wb.Saved) ' ранее сохранённые файлы просто закрываются
        End If
    Next wb
End Sub

Ну и четвертый вариант — тоже закрывает все открытые файлы, только изменения в этих файлах не сохраняются:

Sub CloseAllWorkbooks4()
    ' закрываем все книги, кроме текущей (активной), БЕЗ СОХРАНЕНИЯ изменений
    Dim wb As Workbook: Application.ScreenUpdating = False
    For Each wb In Workbooks    ' перебираем все открытые книги
        If wb.Windows(1).Visible Then If Not wb Is ActiveWorkbook Then wb.Close False
    Next wb
End Sub

Источник

If you are working with multiple Excel files at once, you often find yourself dealing with warning messages when trying to close them. Although it is a good thing to be warned about saving to not lose changes in a workbook, it may become annoying quickly. Thanks to VBA, you can create a macro to close them all, preferably save as well. In this guide, we’re going to show you how to close all workbooks in Excel with VBA.

Preparation

You cannot close all workbooks if your code closes the workbook which includes the code, right? You need to store your code in a special file named Personal.xlsb. Personal.xlsb is a special macro file also known as Personal Macro Workbook. This file will be created automatically when you record a macro in it deliberately. Once created, this workbook will be opened in the background whenever you start Excel.

To check whether the file has been created correctly, open a blank workbook, and activate the View tab in the Ribbon. If the Unhide button is disabled, then your Personal.xlsb file has not been created.

You can easily create it by recording a macro.

Click Record Macro in the Developer tab or Status Bar. If the Developer tab is hidden, see How to display the Excel Developer tab for using advanced features.
Select Personal Macro Workbook from the Store macro in list
Click the OK button to start recording a macro.
If you do not want to record any action, you can click the Stop Macro button right away.

Once the macro recording stops, Excel creates the Personal.xlsb file. You can either use the Unhide command to make it visible or open the VBA window and access it through there.

Write your macros in Personal.xlsb and save the file in the VBA window.

Macro

All you need is to loop through each workbook and execute Close method for the active workbook. A simple For Each loop to iterate all workbook objects in a parent Workbooks object is enough.

You can determine if the workbooks are saved or not by populating the Close method’s SaveChanges argument. The default value of this argument is False which indicates no saving. Set it as True to save changes in your workbooks.

Do not forget to save Personal.xlsb file by the Save button or command in the VBA window.

Close all workbooks without saving changes

Sub CloseAllWorkbooks()
    'Define a workbook variable
    Dim wb As workbook
    'Loop through all workbooks and close them
    For Each wb In Workbooks
        wb.Close
    Next wb
End Sub

Close all workbooks without saving changes

Sub CloseAllWorkbooksAndSave()
    'Define a workbook variable
    Dim wb As workbook
    'Loop through all workbooks, save and close them
    For Each wb In Workbooks
        wb.Close SaveChanges:=True
    Next wb
End Sub

Источник

SpagoR

Пользователь

Сообщений: 39
Регистрация: 01.01.1970

Ребят, как можно макросом закрыть все книги кроме активной?

Просто при работе предыдущего макроса открывает 50 книг, обрабатывает информацию из них и потом они остаются открытыми.

Мне же нужно их закрыть и продолжить работу над активным файлом

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012	Sub cl() Dim wb As Workbook For Each wb In Workbooks If wb.Name <> ActiveWorkbook.Name Then wb.Close False Next End Sub

	> при работе предыдущего макроса открывает 50 книг, обрабатывает информацию из них и потом они остаются открытыми А почему макрос не закрывает книгу после того как обработал ее? Где этот «предыдущий макрос»?

SpagoR

Пользователь

Сообщений: 39
Регистрация: 01.01.1970

{quote}{login=Казанский}{date=07.12.2011 07:04}{thema=}{post}> при работе предыдущего макроса открывает 50 книг, обрабатывает информацию из них и потом они остаются открытыми

А почему макрос не закрывает книгу после того как обработал ее?
Где этот «предыдущий макрос»?{/post}{/quote}

Ну вот собственно я и хочу чтобы он закрывал их) просто это макрос массового открытия из папки.
____________________________________

Sub Get_All_Files()
Dim sFolder As String, sFiles As String, li As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
sFolder = .SelectedItems(1)
End With
Application.ScreenUpdating = False
sFiles = Dir(sFolder & Application.PathSeparator & «*.xls*»)
Do While sFiles <> «»
Workbooks.Open sFiles
Sheets(«Inventarisatie»).Select
Columns(«A:Z»).Select
Selection.Copy
Windows(«Book1»).Activate
Sheets(«Sheet1»).Select
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Dim x As Variant
x = [A3] & » Inventarisatie»
On Error Resume Next
ActiveSheet.Name = x

Range(«A1»).Select

sFiles = Dir
Loop
Application.ScreenUpdating = True

End Sub

____________________________________

Ну и собственно в догонку вопрос — как убрать диалоговое окно выбора папки и сделать чтобы оно автоматически открывало файлы из конкретной папки?

sva

Пользователь

Сообщений: 1027
Регистрация: 23.12.2012

Как-то так:
Sub Get_All_Files()
Dim sFolder As String, sFiles As String, li As Long
sFolder = «D:» ‘здесь указываете свой путь
Application.ScreenUpdating = False
sFiles = Dir(sFolder & Application.PathSeparator & «*.xls*»)
Do While sFiles <> «»
Workbooks.Open sFiles
Sheets(«Inventarisatie»).Columns(«A:Z»).Select.Copy
Windows(«Book1»).Activate
Sheets(«Sheet1»).Select
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(sFiles).Close False
Dim x As Variant
x = [A3] & » Inventarisatie»
On Error Resume Next
ActiveSheet.Name = x

Range(«A1»).Select

sFiles = Dir
Loop
Application.ScreenUpdating = True

End Sub

SpagoR

Пользователь

Сообщений: 39
Регистрация: 01.01.1970

{quote}{login=sva}{date=07.12.2011 07:48}{thema=}{post}Как-то так:
Sub Get_All_Files()
Dim sFolder As String, sFiles As String, li As Long
sFolder = «D:» ‘здесь указываете свой путь
Application.ScreenUpdating = False
sFiles = Dir(sFolder & Application.PathSeparator & «*.xls*»)
Do While sFiles <> «»
Workbooks.Open sFiles
Sheets(«Inventarisatie»).Columns(«A:Z»).Select.Copy
Windows(«Book1»).Activate
Sheets(«Sheet1»).Select
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(sFiles).Close False
Dim x As Variant
x = [A3] & » Inventarisatie»
On Error Resume Next
ActiveSheet.Name = x

Range(«A1»).Select

sFiles = Dir
Loop
Application.ScreenUpdating = True

End Sub{/post}{/quote}

выдает ошибку на строчке
Workbooks.Open sFiles

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012

SpagoR

Пользователь

Сообщений: 39
Регистрация: 01.01.1970

{quote}{login=sva}{date=07.12.2011 07:57}{thema=}{post}Какую?{/post}{/quote}

Run-time error ‘1004’:

‘Andora.xls’ could not be found. Check the spelling of the file name and verify that file location is correct.

If you are trying to open the file from your list of most recently used files on the File menu, make sure that the file has not been renamed, moved, or deleted.

____________________________________-
смысл ошибки я понимаю. Но дело в том что система же захватила имя файла из указанной папки.

И ещё, путь к файлу выглядит так:
\SadnldfsnlGRNL011883GlobalGD

Тоесть файл находится не на моем жестком диске, а на корпоративном сервере.

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012	Тогда, что за файл Andora.xls Excel пытается открыть?

SpagoR

Пользователь

Сообщений: 39
Регистрация: 01.01.1970

{quote}{login=sva}{date=07.12.2011 08:11}{thema=}{post}Тогда, что за файл Andora.xls Excel пытается открыть?{/post}{/quote}

Да правильный файл. В папке по вышеуказанному адресу лежит 49 файлов с названиями стран.

Этот макрос должен все их открыть. Если делать по тому варианту который я предоставил, то всё нормально открывает (при выборе папки вручную). Если же прописать путь к файлу как вы показали, то выбивает ошибку.

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012	Путь должен выглядеть так: sFolder=»\SadnldfsnlGRNL011883GlobalGD»

SpagoR Пользователь Сообщений: 39 Регистрация: 01.01.1970	{quote}{login=sva}{date=07.12.2011 08:23}{thema=}{post}Путь должен выглядеть так: sFolder=»\SadnldfsnlGRNL011883GlobalGD»{/post}{/quote} не помогает

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012	Тогда, не знаю в чем может быть проблема. Может кто из знатоков подскажет.

AKSENOV048 Пользователь Сообщений: 523 Регистрация: 01.01.1970	#14 07.12.2011 23:02:10 предположение… а не может быть из-за того что два PathSeparator. смотрите путь к файлам sFolder=»\SadnldfsnlGRNL011883GlobalGD» и sFiles = Dir(sFolder & Application.PathSeparator & «.xls») получается sFiles = Dir(«\SadnldfsnlGRNL011883GlobalGD»& Application.PathSeparator & «.xls») может надо sFiles = Dir(«\SadnldfsnlGRNL011883GlobalGD»& «.xls») <#0>

Источник

Mishel915

206 / 13 / 2

Регистрация: 10.10.2009

Сообщений: 154

08.11.2009, 20:50. Показов 7540. Ответов 4

Метки нет (Все метки)

Всем доброе время суток !

Две книги Excel (Книга1 и Книга2) закрываются в одном макросе, например так :

Код:

Visual Basic

Sub Макрос1()
On Error Resume Next
     Workbooks("Книга1").Close (SaveChanges)
     Workbooks("Книга2").Close (SaveChanges)
     On Error GoTo 0
End Sub

Макрос1 находится в Книге3. Проэкт состоит из трёх книг — Книга1, Книга2, Книга3.
Если команда о закрытии книг поступает из Книги2, например так :

Код:

Visual Basic

1	Application.Run "'Книга3.xls'!Макрос1",

то закрываются обе (все в одном Макросе1) книги.
Если команда о закрытии книг поступает из Книги1, то закрывается только Книга1. Книга2 остаётся открытой.
Очевидно это происходит из-за того, что управляющая книга (книга с управляющим макросом) закрывается первой, после чего выполнение Макроса1 прекращается.
Такой вопрос : какой должен быть код для закрытия всех книг, записанных в Макросе1, не зависимо от порядка расположения книг в Макросе1. Очевидно в Макросе1 необходимо определить управляющую книгу, т. е. книгу с которой поступила команда, и закрыть её последней.

EducatedFool

0 / 0 / 0

Регистрация: 28.09.2009

Сообщений: 88

08.11.2009, 21:04

Visual Basic

Sub test()
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then wb.Close
    Next
    ThisWorkbook.Close
End Sub

Mishel915

206 / 13 / 2

Регистрация: 10.10.2009

Сообщений: 154

08.11.2009, 21:56

[ТС]

EducatedFool ! Спасибо за этюд.
Да, необходимо было подойти к ThisWorkbook с другой стороны !
Достаточно всего лиш

Visual Basic

Sub test()
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then wb.Close
    Next
End Sub

Книга3 должна оставаться для выбора нового действия.
Не всё пока получается.
1. Если перейти с Книги3 в Книгу1, после чего подать команду о закрытии Книги1, то закрывается!
2. Если перейти с Книги3 в Книгу1, потом перейти в Книгу2, после чего подать команду о закрытии двух книг, то закрываются обе книги!
3. Если перейти с Книги3 в Книгу1, потом перейти в Книгу2, потом перейти в Книгу1, после чего подать команду о закрытии двух книг, то закрывается только Книга1? Книга2 остётся не закрытой?
4. Если перейти с Книги3 в Книгу1, потом перейти в Книгу2, потом перейти в Книгу1, потом перейти в Книгу2, после чего подать команду о закрытии двух книг, то закрываются обе книги!
Таким образом в 3-ем сценарии код почемуто не видит Книги2.

Mishel915

206 / 13 / 2

Регистрация: 10.10.2009

Сообщений: 154

09.11.2009, 14:35

[ТС]

Установил причину не срабатывания кода

Visual Basic

Sub test()
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.Name <> ThisWorkbook.Name Then wb.Close
    Next
End Sub

в 3-ем сценарии. Она такая. В коллекции Workbooks фиксируется определённый порядок чередования открытых книг, который не меняется. Код размещён в Книге3, а запускается с Книги1. Как только в коде подошла очередь закрыть Книгу1, код её закрывает, после чего выполнение кода прекращается так как код запущен с Книги1. Все книги, которые стоят в очереди на закрытие после Книги1, теперь не закроются из-за того, что код уже не выполняется.
Код будет срабатывать всегда, если его запускать с книги в которой он размещён.
Если код запускать с других книг, то на его работу будет влиять порядок размещения открытых книг в коллекции Workbooks! Очевидно на такой случай необходимо перехватывать события на уровне Application.

Mishel915

206 / 13 / 2

Регистрация: 10.10.2009

Сообщений: 154

09.11.2009, 19:51

[ТС]

Работает так :

Visual Basic

Sub Макрос1()
   Dim wb As Workbook
       For Each wb In Workbooks
       If wb.Name <> Application.ActiveWorkbook.Name And wb.Name <> ThisWorkbook.Name Then wb.Close
       Next
   Application.ActiveWorkbook.Close
End Sub

Источник