Макрос для сохранения файла 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, и запускайте макрос.

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

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

I have created a sheet in vba Excel. I would like to save it the current directory, but not in absolute path, then, when this is executed somewhere else, there won’t be problem.

Can somebody help ?

0m3r's user avatar

0m3r

12.2k15 gold badges33 silver badges70 bronze badges

asked Dec 21, 2010 at 9:02

Ndiol Dia's user avatar

I am not clear exactly what your situation requires but the following may get you started. The key here is using ThisWorkbook.Path to get a relative file path:

Sub SaveToRelativePath()
    Dim relativePath As String
    relativePath = ThisWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=relativePath
End Sub

Andrew Richesson's user avatar

answered Dec 21, 2010 at 11:53

Alex P's user avatar

Alex PAlex P

12.2k5 gold badges51 silver badges69 bronze badges

1

VBA has a CurDir keyword that will return the «current directory» as stored in Excel. I’m not sure all the things that affect the current directory, but definitely opening or saving a workbook will change it.

MyWorkbook.SaveAs CurDir & Application.PathSeparator & "MySavedWorkbook.xls"

This assumes that the sheet you want to save has never been saved and you want to define the file name in code.

answered Dec 21, 2010 at 15:24

Dick Kusleika's user avatar

Dick KusleikaDick Kusleika

32.5k4 gold badges51 silver badges73 bronze badges

2

If the Path is omitted the file will be saved automaticaly in the current directory.
Try something like this:

ActiveWorkbook.SaveAs "Filename.xslx"

0m3r's user avatar

0m3r

12.2k15 gold badges33 silver badges70 bronze badges

answered Jun 10, 2015 at 14:26

Jonas Arnout's user avatar

0

Taking this one step further, to save a file to a relative directory, you can use the replace function. Say you have your workbook saved in: c:propertycaliforniasacramentoworkbook.xlsx, use this to move the property to berkley:

workBookPath = Replace(ActiveWorkBook.path, "sacramento", "berkley")
myWorkbook.SaveAs(workBookPath & "" & "newFileName.xlsx"

Only works if your file structure contains one instance of the text used to replace. YMMV.

answered Jul 18, 2014 at 15:36

Tim Schimandle's user avatar

0

Сохранение файла рабочей книги 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 и т.д. в папке «Документы».


 

evgeniy_m

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

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

#1

01.09.2014 23:36:22

Всем доброе время суток! Есть макрос, после обработки которого вылетает окно с сохранением (имя файла берется автоматически с ячейки «А31» ;) :

Код
Имя_для_сохранения = [A31]
    FName = Application.GetSaveAsFilename(InitialFileName:=Имя_для_сохранения, _
                                          FileFilter:="Excel Files (*.xls), *.xls", _
                                          Title:="Выберите имя файла для сохранения")
    If VarType(FName) <> vbBoolean Then ThisWorkbook.SaveAs FName

НО..
как переписать макрос, чтобы файл сохранялся автоматически (без подтверждения кнопки: «Сохранить» ;)  в папку откуда открыт файл?
Заранее спасибо.

 

k61

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

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

#2

02.09.2014 02:26:10

Код
sub ggg()
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & [A31].Value & ".xls"
end sub
 

evgeniy_m

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

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

 

socha

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

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

Здравствуйте.
К продолжению эмой темы.
Надобно сохранить файл под именем ячейки А1, но и папка сохранения должна выбираться автоматически по ячейки А1. То есть путь сохранения C:Заказы «Имя конечной папки А1» «названия файла А1.xls.
Спасибо

 

Sanja

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

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

#5

05.10.2014 17:23:12

socha пишет:

Цитата
сохранить файл под именем ячейки А1, и папка сохранения должна выбираться автоматически по ячейки А1

Так это-ж ещё проще

Код
ActiveWorkbook.SaveAs Filename:=[A1].Value & ".xls" 

Согласие есть продукт при полном непротивлении сторон.

 

socha

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

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

В оригинале у меня место сохранения файла C:РаботаПродажаКлиентыА1″Папка клиента, имя которой совпадает с ячейкой А1.
Но в этой ячейке я указываю не весь путь, а только имя последней папки.  
Спасибо

 

Sanja

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

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

#7

05.10.2014 17:37:42

Цитата
socha пишет: в этой ячейке я указываю…имя последней папки

а имя файла где указываете? Тоже в это-же ячейке (см пост #4)?

Согласие есть продукт при полном непротивлении сторон.

 

socha

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

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

#8

05.10.2014 17:46:10

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

Код
Sub Макрос1() 
Dim a$, d$ 
a = Cells(1, 1) 'a1 name 
d = Cells(2, 1) 'a2 data 
ActiveWorkbook.SaveAs Filename:= _ 
"C:" & a & d & ".xls" 
End Sub

Спасибо

 

Sanja

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

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

#9

05.10.2014 17:51:45

Вы же практически все сделали

Код
ActiveWorkbook.SaveAs Filename:="C:" & a & "" & d &  ".xls" 

Согласие есть продукт при полном непротивлении сторон.

 

socha

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

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

Спасибо, все заработало. Просто не мог разобраться с синтаксисом

 

vlasssov71

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

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

#11

05.10.2014 19:52:33

Еще символы надо убрать, которые в имени файла нежелательны

Код
Public Function УбратьСимволыИмяФайла(s)

s = Replace(s, ".", "_")
s = Replace(s, "/", "_")
s = Replace(s, "", "_")
s = Replace(s, Chr(34), "_")

УбратьСимволыИмяФайла = s

End Function 
 

athe

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

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

#12

19.06.2015 10:38:54

Добрый день.
Вижу что тема не очень свежая, но авось…)
Использую формулу товарища k61 (спасибо ему большое):

Код
sub ggg()
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "" & [A31].Value & ".xls"
end sub

К сожалению есть одно неудобство, данный код делает копию файла с указанным в ячейке названием и переходит в эту копию, закрывая изначальный файл. Может есть  у кого код, который делал бы копию файла, не открывая его и не закрывал бы первичный файл?
Заранее благодарен.
С ув. athe.

Изменено: athe19.06.2015 10:41:32

 

The_Prist

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

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

Профессиональная разработка приложений для MS Office

#13

19.06.2015 10:49:13

Код
ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "" & [A31].Value & ".xls"

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

athe

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

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

The_Prist
Большое спасибо.
Стыд мне и позор… Пошёл дальше читать Слепцову)).

 

RNEtidi

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

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

#15

12.04.2016 15:58:04

Цитата
The_Prist написал:
19 Июн 2015 10:49:13

Код
ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "" & [A31].Value & ".xls"
Код
ThisWorkbook.SaveCopyAs "C:Folder" & NewName

в цикле For..Next выдает ошибку:
Run-time error ‘-2147417848 (80010108)’:
Automation error
The object invoked has disconnected from its clients.

Имя файла NewName изменяется в цикле:

Код
NewName = "Saved_" & x & ".xlsm" 'x - изменяемый циклом параметр

В чем причина может быть? (DoEvents — не помогает).

Изменено: RNEtidi12.04.2016 16:37:05

 

Юрий М

Модератор

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

Контакты см. в профиле

RNEtidi, зачем цитируете всё подряд? Даже подпись. На чём хотели сделать акцент? Кнопка цитирования не для ответа.
И код следует оформлять соответствующим тегом — видели, как у других это выглядит? Ищите такую кнопку и исправьте своё сообщение в части цитаты и оформления. Спасибо!

 

Hugo

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

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

#17

12.04.2016 16:36:25

Цитата
RNEtidi написал: В чем причина может быть?

— да хоть в том, что уже выше озвучивалось — в недопустимом имени файла.

 

RNEtidi

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

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

Hugo

, в моем случае в чем недопустимость имени файла?

 

Юрий М

Модератор

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

Контакты см. в профиле

Никто не видит, что у Вас в ячейке, из которой берётся имя файла )) Чему равна переменная х?

 

RNEtidi

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

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

#20

12.04.2016 17:00:09

Код
For x=1 to n 'n - берется из текстбокса формы: n = Val(Textbox1.Text)
NewName = "Saved_" & x & ".xlsm" 'x - изменяемый циклом параметр
DoEvents
ThisWorkbook.SaveCopyAs "C:Folder" & NewName
Next x

x — изменяемый циклом параметр

 

Hugo

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

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

#21

12.04.2016 17:17:29

Цитата
Юрий М написал: Чему равна переменная х?
 

RNEtidi

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

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

ну для начала x = 1. Потом x = 2. И так далее до n. К примеру n = 5, тогда x изменяется от 1 до 5. Цикл For..Next так работает.

 

Hugo

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

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

Сорри, подслеповат вероятно… :)
Тогда должно работать без ошибок, если запись в каталог разрешена.

 

RNEtidi

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

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

запись в каталог не запрещена, но ошибка все равно выскакивает.

 

Фродо

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

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

#25

12.04.2016 19:16:43

Цитата
RNEtidi написал:
но ошибка все равно выскакивает.

уникальность имени?

у меня простая версия Экселя, в ней нет кнопки «Прочитать мысли и сгенерировать файл пример»

 

RNEtidi

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

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

#26

12.04.2016 19:18:37

Цитата
RNEtidi написал:
Run-time error ‘-2147417848 (80010108)’:
Automation error
The object invoked has disconnected from its clients.
 

Фродо

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

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

#27

12.04.2016 19:23:15

для начало попробуйте все убрать.

Код
ThisWorkbook.SaveCopyAs "C:Folder" & "Saved_" & 1 & ".xlsm"

у меня простая версия Экселя, в ней нет кнопки «Прочитать мысли и сгенерировать файл пример»

 

RNEtidi

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

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

в этом то вся и прелесть: вне цикла все хорошо сохраняет. а в теле цикла при попытке сохранить выскакивает вышеназванная ошибка и excel напрочь зависает.

 

Фродо

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

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

#29

12.04.2016 20:02:38

Код
ThisWorkbook.SaveCopyAs "C:Folder" & NewName true

а так попробуйте

файл пример сделайте

у меня простая версия Экселя, в ней нет кнопки «Прочитать мысли и сгенерировать файл пример»

 

RNEtidi

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

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

#30

12.04.2016 21:49:14

для чего писать true после имени файла?
пример прикрепил. Одну копию сохраняет, а на второй выдает ошибку.

Прикрепленные файлы

  • Example.xlsm (17.4 КБ)

Изменено: RNEtidi12.04.2016 22:35:42
(Перезалил файл. Новый файл пишет log)

0 / 0 / 0

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

Сообщений: 3

1

Макрос для сохранения документов в нужную папку с именем из текста

01.11.2013, 17:44. Показов 15529. Ответов 4


Студворк — интернет-сервис помощи студентам

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

Заранее спасибо



0



0 / 0 / 0

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

Сообщений: 3

01.11.2013, 17:46

 [ТС]

2

вот файл)

Вложения

Тип файла: doc 2.doc (42.0 Кб, 145 просмотров)



0



toiai

3217 / 966 / 223

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

Сообщений: 2,085

01.11.2013, 21:08

3

Вот возможный вариант, запиши код в Normal:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub SaveNewZayvka()
    Dim ImyFile$
    Selection.GoTo What:=wdGoToBookmark, Name:="ТекстовоеПоле74"
    ImyFile = Selection & ".doc"
    ChangeFileOpenDirectory "D:Загрузки" 'здесь путь для сохранения файла
    ActiveDocument.SaveAs2 FileName:=ImyFile, FileFormat:=wdFormatDocument, _
         LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=0
End Sub

и запускай данный макрос после внесения номера заявки.



0



0 / 0 / 0

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

Сообщений: 3

01.11.2013, 23:14

 [ТС]

4

СПАСИБО, ВРОДЕ РАБОТАЕТ))))))))))))))))))



0



0 / 0 / 0

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

Сообщений: 42

24.12.2018, 12:49

5

Добавлено через 10 минут
toiai, Спасибо за код, есть только вопрос как сделать чтобы фафлысохранялись в формате например: «название документа» (которое всегда будет одинаковым) от «дата» (которое будет вставлять я из вставки)?



0



Сохранить в текущую папку

Есть Excel, в котором я написал макрос сохранения файла, но сохраняет почему-то не в папку с моим документом, а в папку MyDocuments (WinXP Eng).

Open «Date.sql» For Output As #1

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

5 ответов

524

03 мая 2004 года

BurAn

42 / / 20.05.2000

Цитата:

Originally posted by TimON
Есть Excel, в котором я написал макрос сохранения файла, но сохраняет почему-то не в папку с моим документом, а в папку MyDocuments (WinXP Eng).

Open «Date.sql» For Output As #1

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

Я бы попробовал вот так:

Dim FileName as String
FileName = App.Path & «Date.sql»
Open FileName For Output As #1

2.0K

03 мая 2004 года

TimON

26 / / 17.02.2003

Цитата:

Originally posted by BurAn

Я бы попробовал вот так:

Dim FileName as String
FileName = App.Path & «Date.sql»
Open FileName For Output As #1

На это он выдёт ошибку:
Run-time error ‘424’
object required

на строчку FileName = App.Path & «Date.sql»

524

03 мая 2004 года

BurAn

42 / / 20.05.2000

Цитата:

Originally posted by TimON

На это он выдёт ошибку:
Run-time error ‘424’
object required

на строчку FileName = App.Path & «Date.sql»

Да… В Excel-e надо по-другому… А иненно:

Dim FileName As String
FileName = Excel.Application.ActiveWorkbook.Path & «Date.sql»
Open FileName For Output As #1
Print #1, «bla-bla-bla-bla»
Close #1

Рад был помочь.

2.0K

05 мая 2004 года

TimON

26 / / 17.02.2003

Цитата:

Originally posted by BurAn

Да… В Excel-e надо по-другому… А иненно:

Dim FileName As String
FileName = Excel.Application.ActiveWorkbook.Path & «Date.sql»
Open FileName For Output As #1
Print #1, «bla-bla-bla-bla»
Close #1

Рад был помочь.

Спасибо!

По ходу дела возник новый вопрос:

Когда записывает в файл Data.sql, то после последней строчки записывается ещё знак переноса строки, нельзя ли, чтоб этот знак не записывался, т.е. чтоб когда открываешь файл, и переходишь в конец файла, то курсор был не на новой строке, а после последней записи.

524

06 мая 2004 года

BurAn

42 / / 20.05.2000

Цитата:

Originally posted by TimON

Спасибо!

По ходу дела возник новый вопрос:

Когда записывает в файл Data.sql, то после последней строчки записывается ещё знак переноса строки, нельзя ли, чтоб этот знак не записывался, т.е. чтоб когда открываешь файл, и переходишь в конец файла, то курсор был не на новой строке, а после последней записи.

Честно сказать не знаю…
А нельзя ли при открытии файла сразу же удалить последний символ?
Может это выход?

Добрый день, уважаемые!

Poltava:

1. Макрос для создания папки написан для удобства, (так хочет пользователь!)

В модуль книги:

Private Sub Workbook_Open()
Dim dt As Date, d As Integer
d = Day(Now)
If d < 1 Or d > 25 Then Exit Sub
dt = GetSetting("NOV", "Run", "LastDate", 0)
If Year(Now) = Year(dt) And Month(Now) = Month(dt) Then Exit Sub
SaveSetting "NOV", "Run", "LastDate", CDbl(Date)
Application.Run "Создание_папки"
End Sub

Каждый раз при открытии книги проверяется текушая дата, если дата в заданном диапазоне (с 1 числа по 25 число любого месяца) однократно запускается макрос «Создание_папки»

Соответственно создается 3 папки (2 за предыдущий месяц и одна за текущий)

Sub Создание_папки()
Dim PathToSave As String, FolderName As String, FellPathToSave As String
Dim fs As Object
PathToSave = "C:"
FolderName = CStr(Format(DateAdd("m", -1, Now), "mmmm yyyy") & " Электроэнергия")
FellPathToSave = PathToSave & FolderName & ""
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(FellPathToSave) Then
   fs.CreateFolder (FellPathToSave)
   End If
       PathToSave = "C:"
       FolderName = CStr(Format(DateAdd("m", -1, Now), "mmmm yyyy") & " Телефоны")
       FellPathToSave = PathToSave & FolderName & ""
       Set fs = CreateObject("Scripting.FileSystemObject")
       If Not fs.FolderExists(FellPathToSave) Then
           fs.CreateFolder (FellPathToSave)
           End If
               PathToSave = "C:"
               FolderName = CStr(Format(DateAdd("m", 0, Now), "mmmm yyyy") & " Водоснабжение")
               FellPathToSave = PathToSave & FolderName & ""
               Set fs = CreateObject("Scripting.FileSystemObject")
               If Not fs.FolderExists(FellPathToSave) Then
                   fs.CreateFolder (FellPathToSave)
                   End If
End Sub

2. Не могу въехать, почему макрос сохраняет в «Мои документы», а если вначале работы с Excel сохранить вручную любой файл в папку «ММММ ГГГГ Электроэнергия», начинает правильно работать и сохранять в ту папку, что прописана в макросе. Вот код:

Sub Сохранить_Электроэнергия()
   Application.ScreenUpdating = False
   Sheets.Add.Name = "Лист1"
   Sheets("ЭЛЕКТРИЧЕСТВО").Select
   Cells.Select
   Selection.Copy
   Sheets("Лист1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
   Range("A1").Select
   ActiveSheet.Name = [D14]
       On Error Resume Next
       Folder$ = "C:" & Sheets("ЭЛЕКТРИЧЕСТВО").Range("d20") & " Электроэнергия" & ""
       Filename = [D14] & ".xls"
           Err.Clear: ActiveSheet.Copy: DoEvents
           If Err Then Exit Sub
           ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
           ActiveWorkbook.Close False
               Sheets("ЭЛЕКТРИЧЕСТВО").Select
               Range("D14").Select
                           Application.DisplayAlerts = False
                           Sheets(Range("D14").Value).Select
                           ActiveWindow.SelectedSheets.Delete
                                       Application.ScreenUpdating = True
                                       Application.DisplayAlerts = True
End Sub

KuklP:

Я не профессионально владею VBA, в те времена, когда я учился в школе и в институте компьютеры занимали помещения в 500 кв.м., а жесткий диск для них был размером с большую кастрюлю (части от этих хард-дисков, можно иногда видеть на дачных участках, их обычно используют в качестве телевизионных антенн :)), поэтому что могу пишу макрорекордером, так мне проще и быстрее.

Макрос:сохранение копии рабочей книги в определенной папке

VanDerGraat

Дата: Вторник, 01.05.2012, 18:58 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

Замечаний:
0% ±


Доброго времени суток.Проконсультируйте,пожалуйста,как сделать макрос,который бы сохранял копию книги в определенной папке под именем вида Имя(I)[I-переменная;I=1,2,…n]. Если такое имя уже существует,то сохраняет под именем Имя(max(I)+1),где max(I)-максимальная из переменных I,содержащихся в именах файлов,сохраненных в папке.
Заранее благодарен за любую помощь.

 

Ответить

Alex_ST

Дата: Среда, 02.05.2012, 10:56 |
Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

Замечаний:
0% ±


2003

А Вам нужна именно нумерация?
А сохранение под именем с добавкой суффикса из даты и времени не подойдёт? Если подойдёт, то посмотрите в топике Макрос Save_Copy_As .
Честно говоря, мне лень возиться с переделкой того макроса…
Попробуйте на его основе сами. А для получения имени с номером можете ввести туда вычисление имени такой функцией:[vba]

Code

Private Function NextName(sPath$, sWdROOT$, sExp$)  ‘ вычисление очередного уникального имени файла с корнем sWdROOT в папке sPath
    NextName = False
    On Error GoTo eXXit
    GetAttr (sPath)   ‘ если папка не существует, то будет ошибка и NextName=False
    Dim i%
    Do
       NextName = sPath & sWdROOT & «(» & i & «)» & sExp
       i = i + 1
    Loop While Dir(NextName) <> «»   ‘ пока имя не будет уникальным в папке
eXXit:    End Function

[/vba]



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STСреда, 02.05.2012, 12:30

 

Ответить

Alex_ST

Дата: Среда, 02.05.2012, 12:59 |
Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

Замечаний:
0% ±


2003

Вот, в обеденный перерыв сделал с автонумерацией:[vba]

Code

Sub Save_Copy_As_I()
‘—————————————————————————————
‘ Procedure    : Save_Copy_As_I
‘ Author       : Alex_ST
‘ Topic_HEADER : Сохранить копию текущего файла, запомнив папку для сохранения
‘ Topic_URL    : http://www.excelworld.ru/forum/2-1639-18265-16-1335949159
‘ DateTime     : 02.05.12, 12:59
‘ Purpose      : Сохранение копии активного файла с автоматическим увеличением суффикса (номера копии)
‘ Notes        : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне)
‘—————————————————————————————
    Const sPath_in_Names = «Path4SaveCopyAs»   ‘ имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла
    Dim sDirPath$, sExp$, sMainName$, FileName, i%
    With ActiveWorkbook
       On Error Resume Next
       sDirPath = .Names(sPath_in_Names).Value   ‘ считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names
       If Err Then .Names.Add sPath_in_Names, .Path & «»: sDirPath = .Path & «»   ‘ если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path
       sDirPath = Mid(sDirPath, 3, Len(sDirPath) — 3)   ‘ убрать из считанного значения в начале «= и в конце »
       sDirPath = sDirPath & IIf(Right(sDirPath, 1) = «», «», «»)  ‘ на всякий случай (если имя было задано в ручную и при этом не верно — без слэша)
       .Names(sPath_in_Names).Value = sDirPath   ‘ запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names

       sExp = Right(.Name, Len(.Name) — InStrRev(.Name, «.») + 1)   ‘ расширение файла вместе с точкой (например, «.xls»)
       sMainName = Left(.Name, Len(.Name) — Len(sExp))
       Do
          FileName = sDirPath & sMainName & «(» & i & «)» & sExp: i = i + 1
       Loop While Dir(FileName) <> «»   ‘ пока имя не будет уникальным в папке
       FileName = Application.GetSaveAsFilename(InitialFileName:=FileName, _
                    FileFilter:=»Excel Files (*» & sExp & «), *» & sExp & «, All Files (*.*),*.*», _
                    Title:=»Сохранение копии файла»)   ‘задать путь сохранения и имя копии файла в окне выбора
       If VarType(FileName) = vbBoolean Then Exit Sub   ‘ если нажали «Отмена», то FileName = False, если «Сохранить» — полный путь к файлу вместе с его именем
       sDirPath = Left(FileName, InStrRev(FileName, «»))   ‘ путь к папке сохранения копий без имени файла
       .Names(sPath_in_Names).Value = sDirPath   ‘ запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names
       .SaveCopyAs FileName
    End With
End Sub

[/vba]



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STСреда, 02.05.2012, 13:01

 

Ответить

light26

Дата: Четверг, 03.05.2012, 00:14 |
Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1341


Репутация:

91

±

Замечаний:
0% ±


2007, 2010, 2013

В обеденный перерыв?
Да я за обед просто набрать бы это не успел smile


Я не волшебник. Я только учусь

 

Ответить

VanDerGraat

Дата: Четверг, 03.05.2012, 08:11 |
Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

Замечаний:
0% ±


Alex_ST
Огромное Вам спасибо!

 

Ответить

Alex_ST

Дата: Четверг, 03.05.2012, 08:43 |
Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

Замечаний:
0% ±


2003

Вадим, ну я же не с нуля набирал, а подпиливал свой же Макрос Save_Copy_As (в тот топик, к стати, я и этот макрос добавил чтобы «Готовое решение» было на любой вкус smile ).
А там больше всяких примочек для удобства, проверок и «защит от дурака», чем собственно главного действия — сохранения копии. А все эти прибамбасы остались практически неизменными.
VanDerGraat, пожалуйста, юзайте.
Но с суффиксом — датой и временем, ИМХО всё-таки лучше. Т.к. при сортировке в проводнике Виндов самый последний файл окажется самым нижним. А вот при обычной нумерации всё красиво будет только до тех пор, пока копий в папке будет до 10 (с суффиксами от 0 до 9).
А если больше, то сортировка в окне начнёт сбиваться (ведь она идёт по тексту в именах файлов).
Чтобы этого не было нужно ограничиться максимальным количеством копий, например в 1000 и присваивать суффиксы типа 001, 002, …, 998, 999.
Но даже если это сделать, то опять же возникнут проблемы когда Вы через некоторое время, сохранив уже сотню копий, захотите удалить совсем старые и уже не нужные.
После такого удаления макрос начнёт нумерацию с 000 и продолжит её пока не упрётся в Ваш самый старый из оставленных не стёртыми файлов.
Так что чистить хранилище лучше только полностью.
А вот при времени и дате никаких ограничений нет. Потому я изначально макрос так и сделал.



С уважением,
Алексей
MS Excel 2003 — the best!!!

Сообщение отредактировал Alex_STЧетверг, 03.05.2012, 08:56

 

Ответить

sdart

Дата: Суббота, 20.09.2014, 00:49 |
Сообщение № 7

Группа: Пользователи

Ранг: Прохожий

Сообщений: 9


Репутация:

0

±

Замечаний:
0% ±


Excel 2003

Alex_ST
Подскажите, как сделать чтобы на уникальность проверялось не все имя в папке, а только его первые 4 символа, например, № 12 СтулШкаф ?

 

Ответить

Alex_ST

Дата: Суббота, 20.09.2014, 21:57 |
Сообщение № 8

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3176


Репутация:

604

±

Замечаний:
0% ±


2003

Не понял вопроса…
Как у Вас нумеруются файлы в папке? Т.е. какой шаблон имени? Что в этом шаблоне — постояная часть, одинаковая у всех файлов, а что — нумерация, уникальная для каждого файла?
Вопрос возник из-за того, что Вы, спросив про первые 4 символа, указали в качестве переменного номера ТЕКСТОВУЮ строку «№ 12». А НУМЕРАЦИЯ возможна только цифрами.



С уважением,
Алексей
MS Excel 2003 — the best!!!

 

Ответить

Pelena

Дата: Суббота, 20.09.2014, 22:21 |
Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 18797


Репутация:

4284

±

Замечаний:
±


Excel 2016 & Mac Excel

sdart, на форуме запрещено задавать новые вопросы в чужих темах. Читайте Правила форума, создавайте свою тему в разделе ВОПРОСЫ ПО VBA. Эта тема закрыта


«Черт возьми, Холмс! Но как??!!»
Ю-money 41001765434816

 

Ответить

Понравилась статья? Поделить с друзьями:
  • Макрос для сохранения файла excel в pdf
  • Макрос для сохранения одного листа excel
  • Макрос для сохранения листа excel в отдельный файл
  • Макрос для сохранения листа excel в pdf
  • Макрос для сохранения документа word