Макрос сохранения файла excel в файл

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

Содержание

  1. Исходные данные
  2. Сохранение файла Excel с названием из ячейки — с привязкой к этой ячейке
  3. Добавление кнопки в Excel для запуска макроса
  4. Сохранение файла Excel с названием из ячейки — без привязки к ячейке
  5. Сохранение файла Excel с названием, которое сформировано из значений двух ячеек

Исходные данные

Сначала давайте разберем исходные данные, которые я буду использовать в примерах. Пусть это будет некая абстракция марок автомобилей с указанием их VIN номера.

Примечание! Я использую Excel 2013.

Скриншот 2

В зависимости от конкретных требований и условий, задачу можно реализовать по-разному, хотя принцип будет один и тот же, в этой статье мы рассмотрим несколько вариаций реализации.

Начнем мы с самой простой ситуации, когда заранее известна ячейка, на основе которой будет сформировано имя файла, и адрес этой ячейки изменяться не будет.

Заметка! Этапы разработки программы – как создаются и проектируются программы?

Итак, данные у нас есть, теперь необходимо написать процедуру на VBA (макрос), которая брала бы значение из конкретной ячейки, в данном случае это будет ячейка B14, и присваивала бы это значение имени файла.

Ниже представлен код процедуры, я его подробно прокомментировал. Единственное скажу, что я во всех примерах сохраняю новые файлы без макросов (расширение .xlsx), т.е. по факту будет один файл с поддержкой макросов, а все производные — без.

Если нужно сохранять макрос в каждом файле, т.е. файлы с поддержкой макросов (расширение .xlsm), то необходимо просто указать другой тип файла при сохранении, а именно xlOpenXMLWorkbookMacroEnabled, в процедурах в комментариях я это указываю.

Открываем в Excel редактор Visual Basic, и вставляем код следующей процедуры в исходный код этой книги (ЭтаКнига, открыть двойным кликом) или в модуль, который Вы предварительно должны создать.

Примечание! Для того чтобы открыть редактор Visual Basic в Excel, необходимо перейти на вкладку «Разработчик» и нажать на кнопку «Visual Basic». Файл Excel с кодом процедуры необходимо сохранить с типом «Книга Excel с поддержкой макросов».

Код процедуры

   
   Sub SaveFile()

   'Объявление переменных
   Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String

   'Временно отключаем показ вспомогательных сообщений
   Application.DisplayAlerts = False

   'Задаём каталог сохранения файла (в данном случае текущий каталог)
   Path = ThisWorkbook.Path & ""

   'Получаем значение ячейки
   CellValue = Range("B14")

   'Формируем итоговый путь и название файла
   FinalFileName = Path & CellValue

   'Сохраняем файл
   ActiveWorkbook.SaveAs FileName:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом

   'Включаем вывод сообщений
   Application.DisplayAlerts = True

   'Сообщение с результатом выполнения процедуры
   MsgBox "Файл успешно сохранен с названием - " & CellValue, vbInformation, "Результат"

  End Sub

После сохранения файла запустите макрос («Макросы -> Выполнить -> SaveFile»).

В результате в моем случае процедура успешно выполнилась, файл сохранился с названием «Марка Авто 1», данное значение взято из ячейки B14, о чем будет свидетельствовать сообщение в конце процедуры. Файл сохранен в каталоге, где и исходный файл (во всех примерах ниже прописано то же самое, т.е. сохранение рядом с исходником, но это Вы можете изменить).

Скриншот 3

Заметка! Статический анализ кода в теории и на практике.

Добавление кнопки в Excel для запуска макроса

Каждый раз открывать окно с макросами и выбирать нужный макрос не очень удобно, поэтому можно легко добавить кнопку где-нибудь рядом с данными и просто нажимать ее. Это делается следующим образом «Вкладка Разработчик -> Вставить -> Кнопка (элемент управления формы)».

Скриншот 4

Затем выберите место, где вставить кнопку, и нажмите туда. После этого появится окно назначения действия, т.е. нужно выбрать, какой макрос запускать при нажатии этой кнопки, выбираем наш макрос, т.е. SaveFile, и нажимаем «ОК».

Скриншот 5

Курс по SQL для начинающих

В итоге появится кнопка с названием «Кнопка», это название лучше изменить, например, на «Сохранить файл». Для этого нажмите правой кнопкой мыши на кнопку и выберите настройки «Изменить текст». В итоге у Вас должно получиться что-то вроде этого.

Скриншот 6

Заметка! ТОП 7 популярных языков программирования.

Сохранение файла Excel с названием из ячейки — без привязки к ячейке

Теперь давайте представим, что заранее мы не можем определить, какая именно ячейка будет формировать название файла (может B14, а может и нет), поэтому мы можем немного скорректировать алгоритм таким образом, чтобы он брал значение из ячейки, которая является активной, но в этом случае Вы, конечно же, предварительно, должны выбрать ее (т.е. встать на нее).

Замените код процедуры следующим кодом, который совсем немного, но изменен.

  
   Sub SaveFile()

  'Объявление переменных
   Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String

   'Временно отключаем показ вспомогательных сообщений
   Application.DisplayAlerts = False

   'Задаём каталог сохранения файла (в данном случае текущий каталог)
   Path = ThisWorkbook.Path & ""

   'Проверка значения ячейки
   If ActiveCell.Value = "" Then
     MsgBox "В ячейке отсутствует значение", vbCritical, "Ошибка!"
     Exit Sub
   End If

   'Получаем значение активной ячейки
   CellValue = ActiveCell.Value

   'Формируем итоговый путь и название файла
   FinalFileName = Path & CellValue

   'Сохраняем файл
   ActiveWorkbook.SaveAs FileName:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом

   'Включаем вывод сообщений
   Application.DisplayAlerts = True

   MsgBox "Файл успешно сохранен с названием - " & CellValue, vbInformation, "Результат"

   End Sub

Проверяем работу, становимся на нужную ячейку, и запускаем макрос (в процедуре я добавил проверку, если выбрана пустая ячейка, возникнет ошибка).

Скриншот 7

Как видим, все отработало.

Сохранение файла Excel с названием, которое сформировано из значений двух ячеек

Теперь представим, что нам нужно сформировать файл с названием из значений двух ячеек. Например, в нашем случае это может быть «Марка Авто – VIN Номер», в качестве разделителя я указал символ – (дефис), но им может выступать любой символ или вовсе отсутствовать.

В этом примере я покажу, как можно это реализовать с привязкой к конкретным ячейкам, в нашем случае B14 и D14.

Код процедуры в данном случае будет выглядеть следующим образом.

   
   Sub SaveFile()

   'Объявление переменных
   Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String

   'Временно отключаем показ вспомогательных сообщений
   Application.DisplayAlerts = False

   'Задаём каталог сохранения файла (в данном случае текущий каталог)
   Path = ThisWorkbook.Path & ""

   'Проверка значения ячеек B14 и D14
   If Range("B14").Value = "" Or Range("D14").Value = "" Then
     MsgBox "В ячейке отсутствует значение", vbCritical, "Ошибка!"
     Exit Sub
   End If

   'Складываем значения из двух ячеек B14 и D14
   CellValue = Range("B14").Value & " - " & Range("D14").Value

   'Формируем итоговый путь и название файла
   FinalFileName = Path & CellValue

   'Сохраняем файл
   ActiveWorkbook.SaveAs FileName:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом

   'Включаем вывод сообщений
   Application.DisplayAlerts = True

   MsgBox "Файл успешно сохранен с названием - " & CellValue, vbInformation, "Результат"

   End Sub

Запускаем макрос.

Скриншот 8

Все ОК, файл создан.

Заметка! Как измерить сложность кода программы при программировании?

Если вдруг нужно реализовать без привязки к конкретным ячейкам, например, значения хранятся в определённых столбцах, но конкретная строка неизвестна Вам заранее. Например, у меня несколько строк со значениями, и какие конкретно значения взять за основу названия файла, я хочу указывать самостоятельно, непосредственно перед сохранением, но при этом не редактировать код процедуры.

Для этого мы снова внесем изменения в нашу процедуру, которая будет работать от активной ячейки (смещение от активной ячейки), только с условием того, что выбран столбец с теми значениями, которые необходимо использовать.

Код процедуры

   
   Sub SaveFile()

   'Объявление переменных
   Dim CellValue As String
   Dim Path As String
   Dim FinalFileName As String

   'Временно отключаем показ вспомогательных сообщений
   Application.DisplayAlerts = False

   'Задаём каталог сохранения файла (в данном случае текущий каталог)
   Path = ThisWorkbook.Path & ""

   'Проверка номера столбца
   If ActiveCell.Column <> 2 Then
     MsgBox "Указан некорректный столбец", vbCritical, "Ошибка!"
     Exit Sub
   End If

  'Проверка значения ячейки
   If ActiveCell.Value = "" Then
     MsgBox "В ячейке отсутствует значение", vbCritical, "Ошибка!"
     Exit Sub
   End If

   'Получаем значение активной ячейки
   CellValue = ActiveCell.Value

   'Смещаемся на 2 столбца, относительно активной ячейки
   ActiveCell.Offset(0, 2).Select

   'Складываем значения из двух ячеек
   CellValue = CellValue & " - " & ActiveCell.Value

   'Формируем итоговый путь и название файла
   FinalFileName = Path & CellValue

   'Сохраняем файл
   ActiveWorkbook.SaveAs FileName:=FinalFileName, _
                      FileFormat:=xlOpenXMLWorkbook
                      'FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Для сохранения файла с макросом

   'Включаем вывод сообщений
   Application.DisplayAlerts = True

   MsgBox "Файл успешно сохранен с названием - " & CellValue, vbInformation, "Результат"

   End Sub

Становитесь на любую ячейку со значением в столбце B, и запускайте макрос.

Заметка! Опрос. Какой операционной системой Вы пользуетесь?

У меня на этом все, надеюсь, материал был Вам полезен, пока!

  • Создание файлов
  • Листы Excel
  • Книги Excel

Данный макрос позволяет упростить процедуру сохранения активного листа в книге Excel в отдельный файл.

Для использования этого макроса на любом листе в книге Excel создайте кнопку, и назначьте ей макрос СохранитьЛистВФайл.

При запуске макроса (нажатии кнопки) будет выведено диалоговое окно выбора имени для сохраняемого файла, после чего текущий лист будет сохранён под заданным именем в выбранной папке.

Сохранение производится в формате XLS (формат Excel 2003)
Если пользователь отказался от ввода имени файла (нажал клавишу ESC или кнопку «Отмена» в диалоговом окне),
то сохранения листа в файл не происходит.

Sub СохранитьЛистВФайл()
    On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Отчёты"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls),", , _
                                             "Введите имя файла для сохраняемого отчёта", "Сохранить")
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
 
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
End Sub

PS: Кто-то может сказать, что для сохранения листа в файл в объектной модели Excel есть метод SaveAs, применимый к объекту Worksheet.

Но, как ни странно, выполнение кода ActiveSheet.SaveAs «<имя файла>» приводит к сохранению книги целиком, что равносильно использованию кода ActiveWorkbook.SaveAs «<имя файла>»

Почему этот метод сохранения работает так нелогично — лично мне не понятно (видимо, Microsoft что-то там перемудрил)

  • 178180 просмотров

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Сохранение файла рабочей книги Excel, существующего или нового, с помощью кода VBA. Методы Save и SaveAs объекта Workbook, параметр SaveChanges метода Close.

Сохранение существующего файла

Сохранить существующий открытый файл рабочей книги Excel из кода VBA можно несколькими способами. В примерах используется выражение ActiveWorkbook, которое может быть заменено на ThisWorkbook, Workbooks(«ИмяКниги.xlsx»), Workbooks(myFile.Name), где myFile — объектная переменная с присвоенной ссылкой на рабочую книгу Excel.

Простое сохранение файла после внесенных кодом VBA Excel изменений:

Сохранение файла под другим именем (исходная рабочая книга будет автоматически закрыта без сохранения внесенных изменений):

ActiveWorkbook.SaveAs Filename:=«C:ТестоваяНоваяКнига.xlsx»

Сохранить файл рабочей книги можно перед закрытием, используя параметр SaveChanges метода Close со значением True:

ActiveWorkbook.Close SaveChanges:=True

Чтобы закрыть файл без сохранения, используйте параметр SaveChanges метода Close со значением False:

ActiveWorkbook.Close SaveChanges:=False

Сохранение файла под другим именем при закрытии рабочей книги:

ActiveWorkbook.Close SaveChanges:=True, Filename:=«C:ТестоваяНоваяКнига.xlsx»

Если в примерах с методом Close параметр SaveChanges пропустить, будет открыто диалоговое окно с запросом о сохранении файла.

Новая книга сохраняется с указанием полного имени:

Workbooks.Add

ActiveWorkbook.SaveAs Filename:=«C:ТестоваяНоваяКнига.xlsx»

После этого к новой книге можно обращаться по имени: Workbooks ("НоваяКнига.xlsx").

Если не указать полное имя для сохраняемого файла:

Workbooks.Add

ActiveWorkbook.Save

тогда новая книга будет сохранена с именем и в папке по умолчанию, например: Книга1.xlsx, Книга2.xlsx, Книга3.xlsx и т.д. в папке «Документы».


Сохранение листов книги как отдельных файлов

Про сборку листов из нескольких книг в одну текущую я уже писал здесь. Теперь разберем решение обратной задачи: есть одна книга Excel, которую нужно «разобрать», т.е. сохранить каждый лист как отдельный файл для дальнейшего использования.

save-sheets-as-files.png

Примеров подобного из реальной жизни можно привести массу. Например, файл-отчет с листами-филиалами нужно разделить на отдельные книги по листам, чтобы передать затем данные в каждый филиал и т.д.

Если делать эту процедуру вручную, то придется для каждого листа выполнить немаленькую цепочку действий (выбрать лист, правой кнопкой по ярлычку листа, выбрать Копировать, указать отдельный предварительно созданный пустой файл и т.д.) Гораздо проще использовать короткий макрос, автоматизирующий эти действия.

Способ 1. Простое разделение

Нажмите сочетание Alt+F11 или выберите в меню Сервис — Макрос — Редактор Visual Basic (Tools — Macro — Visual Basic Editor), вставьте новый модуль через меню Insert — Module и скопируйте туда текст этого макроса:

Sub SplitSheets1()
    Dim s As Worksheet
    For Each s In ActiveWorkbook.Worksheets    'проходим по всем листам в активной книге
        s.Copy       'копируем каждый лист в новый файл
    Next
End Sub

Если теперь выйти из редактора Visual Basic и вернуться в Excel, а затем запустить наш макрос (Alt+F8), то все листы из текущей книги будут разбиты по отдельным новым созданным книгам.

Способ 2. Разделение с сохранением

При необходимости, можно созданные книги сразу же сохранять под именами листов. Для этого макрос придется немного изменить, добавив команду сохранения в цикл:

Sub SplitSheets2()
    Dim s As Worksheet
    Dim wb as Workbook
    Set wb = ActiveWorkbook
    For Each s In wb.Worksheets                                 'проходим во всем листам активной книги
        s.Copy                                                  'сохраняем лист как новый файл
        ActiveWorkbook.SaveAs wb.Path & "" & s.Name & ".xlsx"  'сохраняем файл
    Next
End Sub

Этот макрос сохраняет новые книги-листы в ту же папку, где лежал исходный файл. При необходимости сохранения в другое место, замените wb.Path на свой путь в кавычках, например «D:Отчеты2012» и т.п.

Если нужно сохранять файлы не в стандартном формате книги Excel (xlsx), а в других (xls, xlsm, xlsb, txt и т.д.), то кроме очевидного изменения расширения на нужное, потребуется добавить еще и уточнение формата файла — параметр FileFormat:

ActiveWorkbook.SaveAs wb.Path & "" & s.Name & ".xlsb", FileFormat:=50  

Для основных типов файлов значения параметра FileFormat следующие:

  • XLSX = 51
  • XLSM = 52
  • XLSB = 50
  • XLS = 56
  • TXT = 42

Полный список всех вариантов можно посмотреть в справке MSDN.

Способ 3. Сохранение в новые книги только выделенных листов

Если вы хотите раскидать по файлам не все листы в вашей книге, а только некоторые, то макрос придется немного изменить. Выделите нужные вам листы в книге, удерживая на клавиатуре клавишу Ctrl или Shift и запустите приведенный ниже макрос:

Sub SplitSheets3()
    Dim AW As Window
    Set AW = ActiveWindow
    For Each s In AW.SelectedSheets
        Set TempWindow = AW.NewWindow    'создаем отдельное временное окно
        s.Copy                           'копируем туда лист из выделенного диапазона
        TempWindow.Close                 'закрываем временное окно
    Next
End Sub

Создавать новое окно и копировать через него, а не напрямую, приходится потому, что Excel не умеет копировать группу листов, если среди них есть листы с умными таблицами. Копирование через новое окно позволяет такую проблему обойти.

Способ 4. Сохранение только выделенных листов в новый файл

Во всех описанных выше способах каждый лист сохранялся в свой отдельный файл. Если же вы хотите сохранить в отдельный новый файл сразу группу выделенных предварительно листов, то нам потребуется слегка видоизменить наш макрос:

Sub SplitSheets4()
    Dim CurW As Window
    Dim TempW As Window
    Set CurW = ActiveWindow
    Set TempW = ActiveWorkbook.NewWindow
    CurW.SelectedSheets.Copy
    TempW.Close
End Sub

Способ 5. Сохранение листов как отдельных PDF-файлов

Этот способ чем-то похож на второй, но листы сохраняются не как отдельные книги Excel, а в формате PDF, что часто требуется, если никто не должен менять документ и увидеть ваши формулы. Обратите внимание, что:

  • для этого используется уже другой метод (ExportAsFixedFormat а не Copy)
  • листы выводятся в PDF с параметрами печати, настроенными на вкладке Разметка страницы (Page Layout)
  • книга должна быть сохранена на момент экспорта

Нужный нам код будет выглядеть следующим образом:

Sub SplitSheets5()
    Dim s As Worksheet

    For Each s In ActiveWorkbook.Worksheets
        s.ExportAsFixedFormat Filename:=ThisWorkbook.Path & "" & s.Name & ".pdf", Type:=xlTypePDF
    Next
End Sub

Способ 6. Готовый макрос из надстройки PLEX

Если лень или нет времени внедрять все вышеописанное, то можно воспользоваться готовым макросом из моей надстройки PLEX:

Ссылки по теме

  • Сборка листов из нескольких книг в одну
  • Что такое макросы, куда вставлять код на Visual Basic, как их использовать.

Содержание

  1. Макрос сохранения листа Excel в файл
  2. Комментарии
  3. Excel макрос сохранить лист как отдельный файл

Макрос сохранения листа Excel в файл

Данный макрос позволяет упростить процедуру сохранения активного листа в книге Excel в отдельный файл.

Для использования этого макроса на любом листе в книге Excel создайте кнопку, и назначьте ей макрос СохранитьЛистВФайл.

При запуске макроса (нажатии кнопки) будет выведено диалоговое окно выбора имени для сохраняемого файла, после чего текущий лист будет сохранён под заданным именем в выбранной папке.

Сохранение производится в формате XLS (формат Excel 2003)
Если пользователь отказался от ввода имени файла (нажал клавишу ESC или кнопку «Отмена» в диалоговом окне),
то сохранения листа в файл не происходит.

PS: Кто-то может сказать, что для сохранения листа в файл в объектной модели Excel есть метод SaveAs, применимый к объекту Worksheet.

Но, как ни странно, выполнение кода ActiveSheet.SaveAs » « приводит к сохранению книги целиком, что равносильно использованию кода ActiveWorkbook.SaveAs » «

Почему этот метод сохранения работает так нелогично — лично мне не понятно (видимо, Microsoft что-то там перемудрил)

Комментарии

Доброго времени! Очень полезный макрос, спасибо! Подскажите пожалуйста, что нужно изменить что бы сохранялись несколько листов?

Здравствуйте, макрос отлично работает, но подскажите как подправить чтобы в в файл «отчет» сохранялось два листа? Например: Лист1 и Лист9. Я сам в макросах пока еще плохо разбираюсь. Спасибо.

Спасибо. Разобрался. Нашёл ошибки в библиотеках.)

Спасибо. Всё запустил, но не работает. Пишет не найден проект или библиотека. Простите, не уточнил, поменял ещё саму систему (был XP стал Win7 x64).
Вот мой код:
Private Sub CommandButton2_Click()
On Error Resume Next
Const REPORTS_FOLDER = «C:Users. . . »
MkDir ThisWorkbook.Path & «» & REPORTS_FOLDER
ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & «» & REPORTS_FOLDER
FileName = [b8] & «_» & [b6] & «_» & [b4] & «_» & Format([b2], «DDMMMMYY») & «_» & [c2] & «.xlsx»
Err.Clear: Worksheets(Array(. «, «. «)).Copy: DoEvents
If Err Then Exit Sub
If ActiveWorkbook.Worksheets.Count = 2 And ActiveWorkbook.Path = «» Then
ActiveWorkbook.SaveAs FileName, xlWorkbookNormal
ActiveWorkbook.Close False
End If
End Sub

Убедитесь, что макросы вообще включены в настройках Excel.
Перед запуском файла с макросами, необходимо выполнить следующее:

> найти файл с макросами в папке
> щелкнуть правой кнопкой мыши на файле — Свойства — Разблокировать — ОК
> и только после этого запускать

Перешёл с 2007 на Office 2016, перестали работать макросы. И этот. (((

Добрый день, подскажите, пожалуйста, что надо изменить в макросе, чтобы:
1. Он копировал не весь лист целеком, а только диапазон ВИДИМЫХ ячеек (A1:L50), т.к. этот диапазон только часть отфильтрованного списка.
2. Он копировал только значения, без формул ячеек.

Здравствуйте, Алексей
Да, можно такое сделать, — могу написать макрос под заказ.

Здравствуйте, Игорь.
Подскажите, пожалуйста, возможно ли такое, чтобы Лист можно было сохранять не единожды (по имени в одной ячейке) а сославшись на какой-либо диапазон ячеек. Есть потребность сделать в конкретной папке количество файлов соответствующее количеству дней в месяце(отчет на каждый день). Если в диапазоне ячеек указать даты месяца и по нажатию макрос сохранял бы, файлы с именем Даты.

Можете написать макрос под заказ? Мне надо до понедельника

Напишите ваши контакты, есть несколько задач.

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

Дело в том, что в книге порядка 20-30 листов и каждый лист необходимо сохранить в отдельные папки, соответствующие имени листа.

Дмитрий, а куда уж проще-то. вы нажимаете одну кнопку «Печать», и получаете готовый файл JPG
Зачем ещё-то упрощать.
Можно, конечно, и макрос под заказ написать
Если в формат BMP (или EMF) картинку сохранять — то макрос несложный, если в формат JPG — то макрос сложнее будет (и дороже)
Но я бы на вашем месте не стал изобретать велосипед, а оставил бы все как есть.

Сохраняю листы в JPEG формате, при помощи виртуального принтера «universal document converter» возможно ли упростить процедуру сохранения активного листа?

Здравствуйте, Игорь. Будьте любезны, взгляните на код. Основная часть была взята с другого сайта, часть с Вашего. Суть такая: на первом листе исходные данные и кнопка, на третьем — расчеты с формулами. Необходимо чтобы при нажатии кнопки создавалась папка «Двери» в текущей папке, где лежит этот файл (а если она есть, то сохранялось в нее), а имя файла бралось с листа 1 из ячеек a17 & b17. Сохраняться должен третий лист (он скрыт), формулы на нем заменить на значения. После сохранения новая книга закрывается и выводится сообщение об удачном сохранении файла с именем из ячеек a17 & b17. Сам я методом тыка пытался воплотить это, но лист не хочет сохраняться с указанным именем (используется имя по умолчанию «Книга 2. Книга 3. ). Также непонятно мне как сделать чтобы выскакивало сообщение о результате сохранения. Подскажите пожалуйста.

On Error Resume Next
Const REPORTS_FOLDER = «Двери»
‘ название подпапки, в которую по-умолчанию будет предложено сохранить файл

MkDir ThisWorkbook.Path & «» & REPORTS_FOLDER
‘ создаём папку для файла, если её ещё нет

ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & «» & REPORTS_FOLDER
‘ выбираем стартовую папку

Filename = Range(«a17») & («b17») & «.xls»
‘ вывод диалогового окна для запроса имени сохраняемого файла

If VarType(Filename) = vbBoolean Then Exit Sub
‘ если пользователь отказался от выбора имени файла — отменяем сохранение листа в файл

Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n

Select Case Sheets(1).[Условие]
Case 1
Ar = Array(3)
Case Else
End Select

ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count — 1)
For Each Sh In ThisWorkbook.Worksheets
ArAll(n) = Sh.Index
n = n + 1
Next
ThisWorkbook.Worksheets(ArAll).Copy
Application.Volatile
Application.Calculate
Application.ScreenUpdating = False
For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells
.Value = .Value
End With
Next
Erase ArAll: n = 0
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count — 1 — (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then
ArAll(n) = Sh.Index
n = n + 1
Else: If Sh.Visible = False Then Sh.Visible = True
End If
Next
ActiveWorkbook.Sheets(Ar(0)).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(ArAll).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show

ActiveWorkbook.Close False
End Sub

Dim WB As Workbook
Dim ind As Integer
ind = ActiveSheet.Index
Application.DisplayAlerts = False
Set WB = Workbooks.Add
Dim li As Long
Application.DisplayAlerts = False
ind = 3
For n = ind To 2 Step -1
ThisWorkbook.Sheets(n).Copy Before:=WB.Sheets(1)
Next

pdfFilename = Application.DefaultFilePath & Application.PathSeparator & «имя файла» & Range(«D9»).Value & «.pdf»
WB.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfFilename, OpenAfterPublish:=False

При этом файл создается с названием «имя файла.pdf» начисто игнорируя содержимое ячейки указанной.

Вот макрос, который сохраняет без ограничения 255-ти символов в ячейке:

Источник

Excel макрос сохранить лист как отдельный файл

Часто встречал вопрос: — «Как сохранить лист в отдельный файл?»
Вот пример сохранения сразу несколько листов и по одному.

Корректировка и сокращение макросов приветствуется.

Часто встречал вопрос: — «Как сохранить лист в отдельный файл?»
Вот пример сохранения сразу несколько листов и по одному.

Корректировка и сокращение макросов приветствуется. Wasilich

Сообщение Часто встречал вопрос: — «Как сохранить лист в отдельный файл?»
Вот пример сохранения сразу несколько листов и по одному.

Корректировка и сокращение макросов приветствуется. Автор — Wasilich
Дата добавления — 28.10.2013 в 22:20

AndreTM Дата: Вторник, 29.10.2013, 02:38 | Сообщение № 2

Skype: andre.tm.007
Donate: Q iwi: 9517375010

RAN Дата: Вторник, 29.10.2013, 04:19 | Сообщение № 3
Быть или не быть, вот в чем загвоздка!

Ответить

AndreTM Дата: Вторник, 29.10.2013, 04:44 | Сообщение № 4
Skype: andre.tm.007
Donate: Q iwi: 9517375010

Ответить

Wasilich Дата: Вторник, 29.10.2013, 12:53 | Сообщение № 5
RAN Дата: Вторник, 29.10.2013, 22:27 | Сообщение № 6
Быть или не быть, вот в чем загвоздка!

Ответить

Wasilich Дата: Вторник, 29.10.2013, 23:40 | Сообщение № 7

Спасибо Андрей. Только Ник мой убери, это ж не для меня, и цифорки из кода тоже, иначе будут вопросы — «а зачем цифры?»!

Вот еще варианты в примере, в т.ч. с макросом от AndreTM если он не возражает.

Спасибо Андрей. Только Ник мой убери, это ж не для меня, и цифорки из кода тоже, иначе будут вопросы — «а зачем цифры?»!

Вот еще варианты в примере, в т.ч. с макросом от AndreTM если он не возражает. Wasilich

Спасибо Андрей. Только Ник мой убери, это ж не для меня, и цифорки из кода тоже, иначе будут вопросы — «а зачем цифры?»!

Вот еще варианты в примере, в т.ч. с макросом от AndreTM если он не возражает. Автор — Wasilich
Дата добавления — 29.10.2013 в 23:40

RAN Дата: Среда, 30.10.2013, 00:23 | Сообщение № 8

Любой каприз .

Вариант для 1 листа
[vba]

Любой каприз .

Вариант для 1 листа
[vba]

Быть или не быть, вот в чем загвоздка!

Сообщение Любой каприз .

Вариант для 1 листа
[vba]

RAN Дата: Среда, 30.10.2013, 00:33 | Сообщение № 9
Быть или не быть, вот в чем загвоздка!

Ответить

Wasilich Дата: Среда, 30.10.2013, 01:33 | Сообщение № 10
AndreTM Дата: Среда, 30.10.2013, 02:47 | Сообщение № 11
Skype: andre.tm.007
Donate: Q iwi: 9517375010

Ответить

DAKRAY Дата: Четверг, 09.01.2014, 18:19 | Сообщение № 12

В приложении еще один простенький вариант сохранения.
Изначальный код мне скинул antal10, переделал под свои нужды.

П.С. Только вот никак не получается сделать так, чтобы модуль (функция) тоже копировался в новую книгу. Там у меня сумма прописью. Можно в принципе и значение только копировать, не обязательно с модулем — как проще. Если не сложно help подскажите!)

В приложении еще один простенький вариант сохранения.
Изначальный код мне скинул antal10, переделал под свои нужды.

П.С. Только вот никак не получается сделать так, чтобы модуль (функция) тоже копировался в новую книгу. Там у меня сумма прописью. Можно в принципе и значение только копировать, не обязательно с модулем — как проще. Если не сложно help подскажите!) DAKRAY

Сообщение Всем добрый.

В приложении еще один простенький вариант сохранения.
Изначальный код мне скинул antal10, переделал под свои нужды.

П.С. Только вот никак не получается сделать так, чтобы модуль (функция) тоже копировался в новую книгу. Там у меня сумма прописью. Можно в принципе и значение только копировать, не обязательно с модулем — как проще. Если не сложно help подскажите!) Автор — DAKRAY
Дата добавления — 09.01.2014 в 18:19

shebelme Дата: Понедельник, 06.10.2014, 08:05 | Сообщение № 13
Wasilich Дата: Среда, 08.10.2014, 00:21 | Сообщение № 14

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub Лист_в_файл() ‘Сохранить текущий лист.
Dim List$, iPath$

iPath = «D:Папкапапка» ‘ конкретный адрес для сохранения нового файла

Application.ScreenUpdating = False
Application.DisplayAlerts = False
List = ActiveSheet.Name
Sheets(List).Copy
Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value
Sheets(List).Buttons.Delete ‘Удаляем кнопки
‘Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы
ActiveWorkbook.SaveAs iPath & List ‘& «.xls»
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox «Готово!»
End Sub

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub Лист_в_файл() ‘Сохранить текущий лист.
Dim List$, iPath$

iPath = «D:Папкапапка» ‘ конкретный адрес для сохранения нового файла

Application.ScreenUpdating = False
Application.DisplayAlerts = False
List = ActiveSheet.Name
Sheets(List).Copy
Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value
Sheets(List).Buttons.Delete ‘Удаляем кнопки
‘Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы
ActiveWorkbook.SaveAs iPath & List ‘& «.xls»
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox «Готово!»
End Sub

200?’200px’:»+(this.scrollHeight+5)+’px’);»> Sub Лист_в_файл() ‘Сохранить текущий лист.
Dim List$, iPath$

iPath = «D:Папкапапка» ‘ конкретный адрес для сохранения нового файла

Application.ScreenUpdating = False
Application.DisplayAlerts = False
List = ActiveSheet.Name
Sheets(List).Copy
Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value
Sheets(List).Buttons.Delete ‘Удаляем кнопки
‘Sheets(List).DrawingObjects.Delete ‘Удаляем все элементы
ActiveWorkbook.SaveAs iPath & List ‘& «.xls»
ActiveWorkbook.Close False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox «Готово!»
End Sub

Ферхо Дата: Воскресенье, 07.12.2014, 14:28 | Сообщение № 15

Не претендую ни на что, просто я делаю так (возможно кому-то пригодится идея)

200?’200px’:»+(this.scrollHeight+5)+’px’);»>
‘сохранить лист в отдельном файле
‘sSheetName — имя сохраняемого листа (если такого нет — ни чего не делается)
‘sNewFileName — имя файла (если не задано — берется имя листа)
‘sNewPath — куда сохраняем, если не задано, в текущую
‘sRngDelList — если надо указываем диапазоны столбцов для удаления
‘bDelFurmula — если указано — удаляем формулы и ссылки
‘sSubRun — если нужна дополнительная обработка — укажим нужную процедуру
Function fnSheetsSave(ByVal sSheetName As String, _
Optional ByVal sNewFileName As String = «», _
Optional ByVal sNewPath As String = «», _
Optional ByVal sRngDelList As String = «», _
Optional ByVal bDelFurmula As Boolean = False, _
Optional ByVal sSubRun As String = «») As Boolean

Dim sFullFileName As String, arDelCol, iI As Integer, sCol As String
Dim strPS As String: strPS = Application.PathSeparator

If Not fnSheetsIsExist(sSheetName) Then Exit Function

TRC.Pop «fnSheetsSave»
TRC.INFO «Сохранение листа в отдельную книгу», eColorBloc

If sNewFileName = «» Then sNewFileName = sSheetName

mChkPath:
‘проверим и если что, сформируем путь
If sNewPath = «» Then
sNewPath = ActiveWorkbook.path & strPS
Else
If Right(sNewPath, 1) <> strPS Then sNewPath = sNewPath & strPS
If Not fnPathIsExists(sNewPath) Then
sNewPath = «»
GoTo mChkPath
End If
End If

‘создаем полный путь к новому файлу
sFullFileName = sNewPath & sNewFileName & IIf(fnGetFileExt(sNewFileName) = «», «.xls», «»)

‘возможен долгий процесс, поэтому
‘дадим возможность поработать другим
DoEvents

On Error Resume Next
‘создаем копию листа.
‘создается новая книга и она становится активной
ThisWorkbook.Sheets(sSheetName).Copy
TRC.NOERROR «Лист скопирован в новую книгу (» & sSheetName & «)»
If TRC.IFERROR(«ОШИБКА копирования листа (» & sSheetName & «) %1») Then GoTo lEXITfnSheetsSave
‘после возможно долгого процесса
‘дадим возможность поработать другим
DoEvents

If bDelFurmula = True Then
‘убираем ссылки и формулы
ActiveSheet.Range(«A1»).CurrentRegion.Value = ActiveSheet.Range(«A1»).CurrentRegion.Value
TRC.INFO «Формулы удалены»
End If

‘однозначно убираем перенос по словам
ActiveSheet.Range(«A1»).CurrentRegion.WrapText = False

‘если указаны столбцы на удаление — удалим их
If sRngDelList <> «» Then
arDelCol = Split(sRngDelList, » «)
For iI = 0 To UBound(arDelCol)
sCol = arDelCol(iI)
ActiveSheet.Range(sCol).Delete
Next iI
TRC.INFO «Столбцы удалены (» & sRngDelList & «)»
End If

‘если указана дополнительная функция для обработки — выполним ее
If sSubRun <> «» Then
Application.Run sSubRun
TRC.INFO «Функция дополнительной обработки выполнена (» & sSubRun & «)»
End If

‘сохраняем файл со всеми изменениями
ActiveWorkbook.SaveCopyAs sFullFileName
ActiveWorkbook.Close SaveChanges:=False
TRC.NOERROR «Новая книга сохранена (» & sFullFileName & «)»
If TRC.IFERROR(«ОШИБКА! Книга не сохранена (» & sFullFileName & «) %1») Then GoTo lEXITfnSheetsSave

Не претендую ни на что, просто я делаю так (возможно кому-то пригодится идея)

200?’200px’:»+(this.scrollHeight+5)+’px’);»>
‘сохранить лист в отдельном файле
‘sSheetName — имя сохраняемого листа (если такого нет — ни чего не делается)
‘sNewFileName — имя файла (если не задано — берется имя листа)
‘sNewPath — куда сохраняем, если не задано, в текущую
‘sRngDelList — если надо указываем диапазоны столбцов для удаления
‘bDelFurmula — если указано — удаляем формулы и ссылки
‘sSubRun — если нужна дополнительная обработка — укажим нужную процедуру
Function fnSheetsSave(ByVal sSheetName As String, _
Optional ByVal sNewFileName As String = «», _
Optional ByVal sNewPath As String = «», _
Optional ByVal sRngDelList As String = «», _
Optional ByVal bDelFurmula As Boolean = False, _
Optional ByVal sSubRun As String = «») As Boolean

Dim sFullFileName As String, arDelCol, iI As Integer, sCol As String
Dim strPS As String: strPS = Application.PathSeparator

If Not fnSheetsIsExist(sSheetName) Then Exit Function

TRC.Pop «fnSheetsSave»
TRC.INFO «Сохранение листа в отдельную книгу», eColorBloc

If sNewFileName = «» Then sNewFileName = sSheetName

mChkPath:
‘проверим и если что, сформируем путь
If sNewPath = «» Then
sNewPath = ActiveWorkbook.path & strPS
Else
If Right(sNewPath, 1) <> strPS Then sNewPath = sNewPath & strPS
If Not fnPathIsExists(sNewPath) Then
sNewPath = «»
GoTo mChkPath
End If
End If

‘создаем полный путь к новому файлу
sFullFileName = sNewPath & sNewFileName & IIf(fnGetFileExt(sNewFileName) = «», «.xls», «»)

‘возможен долгий процесс, поэтому
‘дадим возможность поработать другим
DoEvents

On Error Resume Next
‘создаем копию листа.
‘создается новая книга и она становится активной
ThisWorkbook.Sheets(sSheetName).Copy
TRC.NOERROR «Лист скопирован в новую книгу (» & sSheetName & «)»
If TRC.IFERROR(«ОШИБКА копирования листа (» & sSheetName & «) %1») Then GoTo lEXITfnSheetsSave
‘после возможно долгого процесса
‘дадим возможность поработать другим
DoEvents

If bDelFurmula = True Then
‘убираем ссылки и формулы
ActiveSheet.Range(«A1»).CurrentRegion.Value = ActiveSheet.Range(«A1»).CurrentRegion.Value
TRC.INFO «Формулы удалены»
End If

‘однозначно убираем перенос по словам
ActiveSheet.Range(«A1»).CurrentRegion.WrapText = False

‘если указаны столбцы на удаление — удалим их
If sRngDelList <> «» Then
arDelCol = Split(sRngDelList, » «)
For iI = 0 To UBound(arDelCol)
sCol = arDelCol(iI)
ActiveSheet.Range(sCol).Delete
Next iI
TRC.INFO «Столбцы удалены (» & sRngDelList & «)»
End If

‘если указана дополнительная функция для обработки — выполним ее
If sSubRun <> «» Then
Application.Run sSubRun
TRC.INFO «Функция дополнительной обработки выполнена (» & sSubRun & «)»
End If

‘сохраняем файл со всеми изменениями
ActiveWorkbook.SaveCopyAs sFullFileName
ActiveWorkbook.Close SaveChanges:=False
TRC.NOERROR «Новая книга сохранена (» & sFullFileName & «)»
If TRC.IFERROR(«ОШИБКА! Книга не сохранена (» & sFullFileName & «) %1») Then GoTo lEXITfnSheetsSave

Если очень хочется, то можно!

Сообщение Не претендую ни на что, просто я делаю так (возможно кому-то пригодится идея)

200?’200px’:»+(this.scrollHeight+5)+’px’);»>
‘сохранить лист в отдельном файле
‘sSheetName — имя сохраняемого листа (если такого нет — ни чего не делается)
‘sNewFileName — имя файла (если не задано — берется имя листа)
‘sNewPath — куда сохраняем, если не задано, в текущую
‘sRngDelList — если надо указываем диапазоны столбцов для удаления
‘bDelFurmula — если указано — удаляем формулы и ссылки
‘sSubRun — если нужна дополнительная обработка — укажим нужную процедуру
Function fnSheetsSave(ByVal sSheetName As String, _
Optional ByVal sNewFileName As String = «», _
Optional ByVal sNewPath As String = «», _
Optional ByVal sRngDelList As String = «», _
Optional ByVal bDelFurmula As Boolean = False, _
Optional ByVal sSubRun As String = «») As Boolean

Dim sFullFileName As String, arDelCol, iI As Integer, sCol As String
Dim strPS As String: strPS = Application.PathSeparator

If Not fnSheetsIsExist(sSheetName) Then Exit Function

TRC.Pop «fnSheetsSave»
TRC.INFO «Сохранение листа в отдельную книгу», eColorBloc

If sNewFileName = «» Then sNewFileName = sSheetName

mChkPath:
‘проверим и если что, сформируем путь
If sNewPath = «» Then
sNewPath = ActiveWorkbook.path & strPS
Else
If Right(sNewPath, 1) <> strPS Then sNewPath = sNewPath & strPS
If Not fnPathIsExists(sNewPath) Then
sNewPath = «»
GoTo mChkPath
End If
End If

‘создаем полный путь к новому файлу
sFullFileName = sNewPath & sNewFileName & IIf(fnGetFileExt(sNewFileName) = «», «.xls», «»)

‘возможен долгий процесс, поэтому
‘дадим возможность поработать другим
DoEvents

Источник

Adblock
detector

Понравилась статья? Поделить с друзьями:
  • Макрос сохранение файла excel по времени
  • Макрос создающий папку excel
  • Макрос создать таблицу в word
  • Макрос создать столбец в excel
  • Макрос создать папку если ее нет excel