Сохранить копию файла excel макросом - Word и Excel - помощь в работе с программами

Alex_ST

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

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

На лицо ужасный, добрый внутри

По работе на своём компе создаю/модернизирую/заполняю разные таблицы.
По окончании какого-нибудь этапа КОПИЮ таблицы надо выкладывать на общий диск с паролем на изменение (ну, просто для страховки одних пользователей от действий других…).
Конечно, можно воспользоваться стандартными средствами:
— открыть папку назначения, скопировать (drag & drop’ ом) туда файл, открыть его и поставить пароль на открытие… Но уж больно это не удобно, т.к. надо после копирования закрыть свой рабочий файл (имена-то совпадают!!!).
или
— сказать Ёкселю «Сохранить как…» и указать с каким именем, куда и с какими паролями сохранить файл. А потом закрыть тот сетевой, видный для всех, файл и открыть свой рабочий. Это тоже не слишком удобно, т.к. требует много «мышкодвижений».
А недавно поставил себе прогу «PDF-Exchange» и увидел там возможность «Сохранить копию как …».
Оказалось очень удобно, т.к. при этом текущий открытый файл не закрывается, а просто его копия сохраняется в указанном месте с указанными свойствами (всё это задаётся в стандартных виндовых окнах).
Вот и подумал, а вдруг гуру форума посоветуют как можно сделать макрос, осуществляющий аналогичную вункцию в Ёкселе?
Очевидно, что макрос (ну, например, Save_Copy_As) должен лежать в личной книге макросов (Personal.xls)…
А вот как «Сохранить как…», не закрывая текущего файла?

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

Alex_ST

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

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

На лицо ужасный, добрый внутри

Сразу оговариваю:
макросы типа
Sub Save_File_As()
ActiveWorkbook.SaveAs _
Filename:=»трам-пам-пам.xls», _
FileFormat:=xlNormal, _
Password:=»», _
WriteResPassword:=»», _
ReadOnlyRecommended:=True, _
CreateBackup:=False
End Sub
не подходят, т.к. это как раз и есть описанный мною выше второй случай…

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

tolikt Пользователь Сообщений: 367 Регистрация: 01.01.1970 tolikt	.SaveCopyAs чем не устраивает?

The_Prist

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

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

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

ThisWorkbook.Password = «1»
ThisWorkbook.SaveCopyAs ‘полный путь, включая расширение файла. ДОЛЖЕН БЫТЬ В ДРУГОЙ ПАПКЕ, дабы не было конфликта при совпадении имен.
ThisWorkbook.Password = «»

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

Alex_ST Пользователь Сообщений: 2746 Регистрация: 22.12.2012 На лицо ужасный, добрый внутри	Метод SaveCopyAs требует непосредственного указания пути и имени сохранения, а хотелось бы по вызову макроса выйти на стандартное окно выбора пути и имени сохранения … С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!) <#0>

Alex_ST Пользователь Сообщений: 2746 Регистрация: 22.12.2012 На лицо ужасный, добрый внутри	Да и к тому же метод SaveCopyAs не предполагает задания опций сохранения (пароль, предложение открыть только для чтения и т.п.) С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!) <#0>

tolikt Пользователь Сообщений: 367 Регистрация: 01.01.1970 tolikt	Наверное, я что-то не понял… Т.к. думал, что пользователь класса Alex_ST уж сумеет как-то в макросе подогнать под себя SaveCopyAs через InputBox или ещё как-то… В чём хитрость-то?

The_Prist

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

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

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

{quote}{login=Alex_ST}{date=01.06.2010 01:56}{thema=}{post}Метод SaveCopyAs требует непосредственного указания пути и имени сохранения, а хотелось бы по вызову макроса выйти на стандартное окно выбора пути и имени сохранения …{/post}{/quote}А кто мешает перед этим вывести диалог?

Dim sFileName As String, sExpansion As String
BEGIN_:
sFileName = ThisWorkbook.Name
sExpansion = Right(sFileName, Len(sFileName) — InStrRev(sFileName, «.») + 1)
sFileName = Application.GetSaveAsFilename
If sFileName = «False» Then Exit Sub

sFileName = sFileName & IIf(Right(sFileName, Len(sExpansion)) <> sExpansion, sExpansion, «»)
If sFileName = ThisWorkbook.FullName Then
MsgBox «Нельзя сохранить файл под имененм открытого файла!», vbCritical + vbYesNo, «Ошибка»
GoTo BEGIN_
End If
ThisWorkbook.Password = «1»
ThisWorkbook.SaveCopyAs sFileName
ThisWorkbook.Password = «»

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

The_Prist

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

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

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

{quote}{login=Alex_ST}{date=01.06.2010 01:59}{thema=}{post}Да и к тому же метод SaveCopyAs не предполагает задания опций сохранения (пароль, предложение открыть только для чтения и т.п.){/post}{/quote}Алекс, Вы хоть посмотрели, что я предложил? Вы сначала задаете книге пароль, затем сохраняете, затем убираете пароль.

Тоже самое можно сделать и с другими атрибутами(только чтение через GetAttr например).

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

Alex_ST Пользователь Сообщений: 2746 Регистрация: 22.12.2012 На лицо ужасный, добрый внутри	Я, конечно, естественно, смогу сделать InputBox для задания пути для SaveCopyAs, но, ИМХО, InputBox и окно задания пути сохранения файла — это «две большие разницы» … С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!) <#0>

The_Prist

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

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

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

{quote}{login=Alex_ST}{date=01.06.2010 02:08}{thema=}{post}Я, конечно, естественно, смогу сделать InputBox для задания пути для SaveCopyAs, но, ИМХО, InputBox и окно задания пути сохранения файла — это «две большие разницы» …{/post}{/quote}Я Вам уже целый пример накатал — чем он не устраивает? Выбор через диалог, сохраняет куда укажешь и с паролем, да еще и предупреждает, если такой файл есть.

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

Alex_ST

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

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

На лицо ужасный, добрый внутри

The_Prist, вы с такой скоростью создаёте свои ответы пока я ввожу свои, что я их просто не успеваю читать…
Ща буду разбираться… Беру тайм-аут на осмысливание.
Скорее всего до завтра, т.к.у нас на работе сегодня отмечается «День Корпорации» (ввиду кризиса — на рабочих местах, а не на природе), поэтому, прошу пардону, с ответами немного торможу, хотя пока ещё вполне адекватен, но что будет дальше …

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

Alex_ST

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

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

На лицо ужасный, добрый внутри

The_Prist,спасибо!
Всё отлично работает. Завтра «дополирую» диалогами для задания пассворда …
А как бы при сохранении копии задавать «Рекомендовать открытие только для чтения?»

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

Alex_ST

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

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

На лицо ужасный, добрый внутри

К стати, не подскажите «на вскидку» как к имени файла при сохранении добавить перед расширением суффикс — дату и время сохранения? (ну, например, Имя_моего_рабочего_файла(01-06-2010 14-30).xls

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

The_Prist Пользователь Сообщений: 14182 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office	SetAttr ThisWorkbook.FullName, vbReadOnly Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

Alex_ST Пользователь Сообщений: 2746 Регистрация: 22.12.2012 На лицо ужасный, добрый внутри	К сожалению, свойство vbReadOnly при SaveCopyAs задать не удаётся… А нельзя ли его задать для уже созданного файла-копии? С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!) <#0>

The_Prist

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

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

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

Алекс, ну чтоже ВЫ так? Я ж еще в начале писал — «Вы сначала задаете книге пароль, затем сохраняете, затем убираете пароль.

Тоже самое можно сделать и с другими атрибутами(только чтение через GetAttr например).»

Т.е. сначала Вы сохраняемой книги присваиваете все эти атрибуты, затем сохраняете, потом убираете.

sFileName = sFileName & IIf(Right(sFileName, Len(sExpansion)) <> sExpansion, sExpansion, «»)
If sFileName = ThisWorkbook.FullName Then
MsgBox «Нельзя сохранить файл под имененм открытого файла!», vbCritical + vbYesNo, «Ошибка»
GoTo BEGIN_
End If
ThisWorkbook.Password = «1»:SetAttr ThisWorkbook.FullName, vbReadOnly
ThisWorkbook.SaveCopyAs sFileName
ThisWorkbook.Password = «»:SetAttr ThisWorkbook.FullName, vbNormal

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

Hugo Пользователь Сообщений: 23257 Регистрация: 22.12.2012	Alex_ST, про дату в названии есть в приёмах: http://www.planetaexcel.ru/tip.php?aid=72

Alex_ST

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

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

На лицо ужасный, добрый внутри

Спасибо. Разобрался.
Только чтобы всё правильно работало нужно не атрибуты файла через
SetAttr ActiveWorkbook.FullName, vbReadOnly устанавливать, т.к. это ничего не даёт , а
ActiveWorkbook.Password = «ххх» задаёт пароль НА ОТКРЫТИЕ

Надо вот так:
With ActiveWorkbook
.WritePassword = «1»
.ReadOnlyRecommended = True
.SaveCopyAs sFileName
.WritePassword = «»
.ReadOnlyRecommended = False
End With

Если кому-нибудь интересно, то «причёсанный» вариант — в файле.

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

Alex_ST

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

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

На лицо ужасный, добрый внутри

#20

08.02.2012 12:01:30

Приходится у себя на компе вести несколько учётных файлов, а их копии регулярно скидывать в разные директории на общем ресурсе.
Достало постоянно выбирать куда и какой файл сохранять…
Переделал макрос Save_Copy_As так, что путь последнего сохранения копии запоминается в самом файле в коллекции Names
Два дня поюзал — понравилось!

Код

Sub Save_Copy_As()   
'---------------------------------------------------------------------------------------   
' Procedure    : Save_Copy_As   
' Author       : Alex_ST   
' Topic_HEADER : Как макросом сохранить копию текущего файла?   
' Topic_URL    : http://www.planetaexcel.ru/forum.php?thread_id=16506   
' DateTime     : 08.02.12, 12:00   
' Purpose      : Сохранение копии активного файла   
' Notes        : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне)   
'---------------------------------------------------------------------------------------   
   Const sPath_in_Names = "Path4SaveCopyAs"   ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла   
   Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"    ' суффикс к имени файла копии - дата и время сохренения копии файла   
   Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$   
   Dim bReadOnlyRecommended As Boolean   
   With ActiveWorkbook   
      FileName = .Name   ' например, "Книга1.xls"   
      sExp = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)   ' расширение файла вместе с точкой (например, ".xls")   
      FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp   ' например, "Книга1 [2012.02.06 15-24'39''].xls"   
      On Error Resume Next   
      sDirPath = .Names(sPath_in_Names).Value   ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names   
      If Err Then .Names.Add sPath_in_Names, .Path & "": sDirPath = .Names(sPath_in_Names).Value   ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным 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   
      sFullFilePath = sDirPath & FileName   ' полный путь сохранения вместе с полным именем копии   
REPEAT_:   
      FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _   
                                               FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _   
                                               Title:="Сохранение копии файла")   'задать путь сохранения и имя копии файла в окне выбора   
      If VarType(FileName) = vbBoolean Then Exit Sub   ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем   
      If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_   
      sDirPath = Left(FileName, InStrRev(FileName, ""))   ' путь к папке сохранения копий без имени файла   
      .Names(sPath_in_Names).Value = sDirPath   ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names   
      bReadOnlyRecommended = .ReadOnlyRecommended   ' запомнить параметры исходного файла   
      .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7)   ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7   
      .SaveCopyAs FileName   
      .ReadOnlyRecommended = bReadOnlyRecommended   ' восстановить параметры исходного файла   
   End With   
End Sub

С уважением, Алексей (ИМХО: Excel-2003 — THE BEST!!!)
<#0>

Источник

Как создать резервную копию книги с сегодняшней датой

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

Что делает макрос: Макрос позволяет создать резервную копию книги и сохраняет ваш файл в папке с сегодняшней датой.

Содержание

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

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

Хитрость данного макроса заключается в сопоставлении частей файла. Новое имя файла состоит из трех частей: путь, исходный файл и сегодняшняя дата.

Путь определяем с помощью свойства Path объекта ThisWorkbook.
Второй частью нового файла является исходное имя файла. Мы используем свойство Name объекта ThisWorkbook.
Текущую дату берем с помощью функции Date. Вы заметите, что мы форматируем дату (Format (Date, «мм-дд-гг»)). Это происходит потому, что по умолчанию функция даты возвращает мм / дд / гггг. Мы используем дефис вместо слэша, иначе это вызовет ошибку при попытке сохранить файл (Windows не позволяет использовать «/» в именах файлов.)

Код макроса

Sub SozdatRezervnuyuKopiyu()
'Сохранить книгу с новым именем
ThisWorkbook.SaveCopyAs _
Filename:=ThisWorkbook.Path & "" & _
Format(Date, "mm-dd-yy") & " " & _
ThisWorkbook.Name
End Sub

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

Используем одну единственную строку, которая с помощью метода SaveCopyAs создает новый имя файла и использует метод для сохранения файла.

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

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

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

Источник

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

Источник

Макрос Save_Copy_As

Alex_ST

Дата: Вторник, 07.02.2012, 17:04 |
Сообщение № 1

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Данный макрос, помещённый в Personal.xls, при его вызове сохраняет копию активной книги в заданной в диалоге выбора папке.
Путь к папке для сохранения копий хранится в коллекции Names самой сохраняемой книги. Поэтому путь сохранения копии приходится задавать только один раз — при первом сохранении копии. В последующем диалог сохранения копии будет открываться уже на нужной папке.
Сохраняемые копии имеют то же имя, что и файл-оригинал, но с приписанным перед расширением суффиксом — датой и временем сохранения копии.
[vba]

Code

Sub Save_Copy_As()
‘—————————————————————————————
‘ Procedure    : Save_Copy_As
‘ Author       : Alex_ST
‘ DateTime     : 07.02.2012, 17:05
‘ URL          : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875
‘ Purpose      : Сохранение копии активного файла
‘ Notes        : Путь сохранения копий хранится в  коллекции .Names книги (в именованном диапазоне)
‘—————————————————————————————
      Const sPath_in_Names = «Path4SaveCopyAs»   ‘ имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла
      Dim sSuff$: sSuff = » [» & Format(Now, «yyyy/mm/dd hh-mm’ss»») & «]»    ‘ суффикс к имени файла копии — дата и время сохренения копии файла
      Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$
      Dim bReadOnlyRecommended As Boolean
      With ActiveWorkbook
         FileName = .Name   ‘ например, «Книга1.xls»
         sExp = Right(FileName, Len(FileName) — InStrRev(FileName, «.») + 1)   ‘ расширение файла вместе с точкой (например, «.xls»)
         FileName = Left(FileName, Len(FileName) — Len(sExp)) & sSuff & sExp   ‘ например, «Книга1 [2012.02.06 15-24’39»].xls»
         On Error Resume Next
         sDirPath = .Names(sPath_in_Names).Value   ‘ считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names
         If Err Then .Names.Add sPath_in_Names, .Path & «»: sDirPath = .Names(sPath_in_Names).Value   ‘ если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным 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
         sFullFilePath = sDirPath & FileName   ‘ полный путь сохранения вместе с полным именем копии
REPEAT_:
         FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _
                      FileFilter:=»Excel Files (*» & sExp & «), *» & sExp & «, All Files (*.*),*.*», _
                      Title:=»Сохранение копии файла»)   ‘задать путь сохранения и имя копии файла в окне выбора
         If VarType(FileName) = vbBoolean Then Exit Sub   ‘ если нажали «Отмена», то FileName = False, если «Сохранить» — полный путь к файлу вместе с его именем
         If FileName = .FullName Then MsgBox «Здесь нельзя сохранить файл под таким именем!», 16, «Ошибка»: GoTo REPEAT_
         sDirPath = Left(FileName, InStrRev(FileName, «»))   ‘ путь к папке сохранения копий без имени файла
         .Names(sPath_in_Names).Value = sDirPath   ‘ запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names
         bReadOnlyRecommended = .ReadOnlyRecommended   ‘ запомнить параметры исходного файла
         .ReadOnlyRecommended = —(MsgBox(«Рекомендовать открывать файл только для чтения?», 36) — 7)   ‘ MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7
         .SaveCopyAs FileName
         .ReadOnlyRecommended = bReadOnlyRecommended   ‘ восстановить параметры исходного файла
      End With
End Sub

[/vba]

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

Сообщение отредактировал Alex_ST — Вторник, 07.02.2012, 17:19

Ответить

Alex_ST

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

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

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

Сообщений: 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/3-1293-18266-16-1335949341
‘ DateTime     : 02.05.12, 13:02
‘ 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:02

Ответить

Gloom

Дата: Пятница, 13.07.2012, 14:35 |
Сообщение № 3

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

Ранг: Новичок

Сообщений: 22

Репутация:
0
±

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

Рад приветствовать, О, Великий и Фсимагучий!
Умоляю, подскажи, что добавить в сие чудо,
чтобы макрос включался не с кнопки а автозапуском при открытии книги и творил то же самое, через заданный промежуток времени?!
Можно ли убрать из макроса запрос на подтверждение сохранения, а просто прописать адрес в теле кода?
Буду предельно признателен за любую помощь.

-=*=-

Ответить

Alex_ST

Дата: Пятница, 13.07.2012, 15:53 |
Сообщение № 4

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Сегодня уже не успею: конец пятницы, надо завершить пару-тройку мелких дел.
А дома в выходные нет возможности надолго засесть за комп.
Попробую сделать что-нибудь на следующей неделе.

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

Ответить

Alex_ST

Дата: Понедельник, 16.07.2012, 17:12 |
Сообщение № 5

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

В черновом варианте сделал.
Пока не как надстройка — так проще отлаживать. Потом переделать в надстройку не трудно.
Потестируйте.
Что-то я там, кажется, перемудрил с защитами от ошибок… А может и нет. Надо поюзать, посмотреть «в разных позах».
Макрос:
1. Проверяет в ходе работы доступность папки бэкапов на запись. Если папка вдруг станет недоступна, то останавливается с предупреждением.
2. Производит записи копий не только по таймеру, но и при сохранениях книг.
3. В автоматическом режиме не бэкапит те книги, которые не изменялись, а также надстройки.

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

Сообщение отредактировал Alex_ST — Понедельник, 16.07.2012, 20:38

Ответить

Alex_ST

Дата: Вторник, 17.07.2012, 12:24 |
Сообщение № 6

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Чуть полирнул во время обеда.
Проверьте.

К сообщению приложен файл:

4169101.xls
(81.0 Kb)

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

Сообщение отредактировал Alex_ST — Вторник, 17.07.2012, 12:46

Ответить

Gloom

Дата: Пятница, 20.07.2012, 12:11 |
Сообщение № 7

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

Ранг: Новичок

Сообщений: 22

Репутация:
0
±

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

Прошу прощения за длительное молчание.
Помучал файлик, вроде все работает. По каким то причинам не всегда работает хоткей на вызов бокса, (запускаю из вба Show_), при нажатии кнопки ON-OFF надпись не меняется, состояние видно только по положению кнопки (утоплена/отжата) и по периодическим подвисонам при сохранении (файлы гигантские у меня). Пытался перенести все добро в личную книгу макросов, видимо сделал как то не так, материться на каждом шагу, в макросах я пока криворук sad

-=*=-

Ответить

Alex_ST

Дата: Пятница, 20.07.2012, 12:59 |
Сообщение № 8

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Gloom,
Вы слишком долго молчали.
Я как раз сейчас собрался выключать компьютер на долго — ухожу в отпуск на 2 недели.
Ещё бы 20 минут и я бы уже вообще не ответил.

Только что проверил: у меня с кнопкой всё в порядке и в 2003, и в 2010-ом Excel’e
Переносить очень просто:
1. Мышкой тащите к себе в Personal.xls модули frmAutoSaveCopy и modAutoSaveCopy
2. Из модуля книги ThisWorkbook копируете всё содержимое и вставляете в свой модуль книги (скорее всего он называется ЭтаКнига)
3. Программное имя листа «Лист1» в своём Personal.xls меняете на имя «ShtSetup»
Программное имя — это не имя листа. Оно изменяется только в VBE :

Всё. Выключаюсь. Убегаю чемодан паковать. Через 3 часа поезд.

К сообщению приложен файл:

5743661.jpg
(52.7 Kb)

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

Ответить

Gloom

Дата: Пятница, 20.07.2012, 13:07 |
Сообщение № 9

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

Ранг: Новичок

Сообщений: 22

Репутация:
0
±

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

Благодарю.
Хорошего отдыха! smile

-=*=-

Ответить

Alex_ST

Дата: Пятница, 20.07.2012, 15:44 |
Сообщение № 10

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Выдалась пара минут до отъезда.
Вот, сделал надстройку.
Положите её в папку C:UsersИмя_ПользователяAppDataRoamingMicrosoftAddIns и подключите после запуска Excel’я (2003: Сервис-Надстройки-…) или просто положите в XLSTART рядом с Personal.xls (тогда она автоматом подключится при запуске)

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

Ответить

Gloom

Дата: Понедельник, 30.07.2012, 09:36 |
Сообщение № 11

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

Ранг: Новичок

Сообщений: 22

Репутация:
0
±

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

Работает безупречно!
Многим покажется мелочью, но всем кто безвозвратно утрачивал результат своей работы за полдня настоятельно рекомендую!
Невидимый и ненадоедливый ангел-хранитель Ваших потуг и усилий.

З.Ы. Пару минут искал в панелях кнопки или менюшки от настройки happy , ВЫЗОВ МЕНЮ (Alt+Ctrl+Del)

-=*=-

Ответить

Alex_ST

Дата: Воскресенье, 05.08.2012, 14:20 |
Сообщение № 12

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Рад, что помог.

Quote (Gloom)

Пару минут искал в панелях кнопки или менюшки от настройки

Если бы я сделал кнопочку, то её мог бы нажать любой «лапоть», портящий Вам файлы, и выйти в режим настройки с соответствующими последствиями. Поэтому и оставил вызов по горячим клавишам Ctrl+Shift+S
А при чём здесь «фигура из трёх пальцев» biggrin

Quote (Gloom)

(Alt+Ctrl+Del)

я, честно говоря, не понял sad

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

Сообщение отредактировал Alex_ST — Воскресенье, 05.08.2012, 14:21

Ответить

Alex_ST

Дата: Среда, 08.08.2012, 14:20 |
Сообщение № 13

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

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

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

Ответить

Гость

Дата: Четверг, 06.09.2012, 18:45 |
Сообщение № 14

Alex_ST,

Сразу прошу прощения, если вопрос дурацкий. Но уже полдня гуглю, и чего то никак.

Есть файл, который необходимо сохранять с именем содержащим текущую дату+1.

Сейчас это выглядит так:
[vba]

Код

Dim r As Date
r = Format(Now(), «dd mmmm yyyy»)
ActiveWorkbook.SaveAs Filename:= _
«F:Работа\Заказ_» & r & «.xls», FileFormat:=xlExcel8 _
, Password:=»», WriteResPassword:=»», ReadOnlyRecommended:=True, _
CreateBackup:=False

[/vba]

Но мне надо чтобы формат даты был не dd mmmm yyyy, наоборот сначала год, потом месяц, потом собственно число. Такое возможно?
И ещё как сделать чтобы дата была +1, т.е. если сегодня 6 сентября 2012г, надо чтобы файл был «Заказ_20120907»

Буду премного благодарен за помощь. Ну или за посыл в верном направлении.

Ответить

Alex_ST

Дата: Четверг, 06.09.2012, 21:39 |
Сообщение № 15

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

И вовсе незачем было долго гуглить.
Достаточно было просто нажать F1, поставив курсор в своём коде на слово Now , чтобы моментально узнать, что эта функция возвращает дату и время, а посмотрев по See Also на функцию Date, узнать, что она возвращает дату.
А точно также, встав курсором на слово Format, можно было узнать про аргументы этой функции (да в конце-концов просто логическим путём можно было догадаться, что если хочешь формат ГОД-МЕСЯЦ-ДЕНЬ, то и в аргументах функции параметры должны быть указаны в таком же порядке)
Т.е. Вам нужно было всего лишь написать:[vba]

Code

Format(Date + 1, «yyyy mm dd»)

[/vba]

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

Сообщение отредактировал Alex_ST — Четверг, 06.09.2012, 21:44

Ответить

Гость

Дата: Пятница, 07.09.2012, 20:39 |
Сообщение № 16

Quote (Alex_ST)

Достаточно было просто нажать F1

Мда, а слона то я и не заметил.

Quote (Alex_ST)

поставив курсор в своём коде на слово Now , чтобы моментально узнать, что эта функция возвращает дату и время, а посмотрев по See Also на функцию Date, узнать, что она возвращает дату.

Я в макрос не то, чтобы чайник… Есть те кто хуже чайников?

Quote (Alex_ST)

логическим путём можно было догадаться, что если хочешь формат ГОД-МЕСЯЦ-ДЕНЬ, то и в аргументах функции параметры должны быть указаны в таком же порядке

Ага, я сначала тоже так подумал, но оказалось, что всё равно сохраняет в формате дд/мммм/уууу.

Quote (Alex_ST)

Format(Date + 1, «yyyy mm dd»)

Спасибо большое!

Ответить

Alex_ST

Дата: Понедельник, 22.09.2014, 21:22 |
Сообщение № 17

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

Тут в другом топике попросили подпилить процедуры так, чтобы имя копии бралось из ячейки листа.
Спрошено-сделано. А за одно и причесал два предыдущих макроса. См. приаттаченный файл.
В новом макросе Save_Copy_As_Name_And_Index имя сохраняемого файла составляется из двух частей: корня и суффикса. Корень задаётся в ячейке, на которую указывает имя ROOT. Суффикс — это 4-значный накопительный индекс.
В остальном принцип тот же, что и в предыдущих процедурах: путь для сохранения копий хранится в именах под указателем Path4SaveCopyAs
Если в файле такое имя не найдено в книге, то оно создаётся автоматически и содержит для начала путь к активной книге. Сохранение копии предлагается по последнему указанному пользователем пути.
Если имя ROOT не задано в книге, то оно создаётся «отвязанным от ячейки» и равным «Модель не задана»
После чего не составляет труда «привязать» это имя к нужной ячейке, используя диспетчер имён.
Для того, чтобы при сохранении файла под именем, задаваемым в ячейке в ручную, не возникало проблем, добавлена функция исправления (замены) не допустимых в именах файлов символов
на символ _
В общем, комментариев там много. Разберётесь, кому нужно сами. А если всё-таки будут вопросы, спрашивайте.

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

Сообщение отредактировал Alex_ST — Понедельник, 22.09.2014, 21:38

Ответить

nikola77

Дата: Среда, 25.03.2015, 10:19 |
Сообщение № 18

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

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

Сообщений: 3

Репутация:
0
±

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

Excel 2010

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

Ответить

Alex_ST

Дата: Среда, 25.03.2015, 12:49 |
Сообщение № 19

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

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

Сообщений: 3176

Репутация:
604
±

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

2003

А если включить макрорекордер, записать процесс сохранения и самому попытаться разобраться?

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

Ответить

nikola77

Дата: Среда, 25.03.2015, 13:06 |
Сообщение № 20

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

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

Сообщений: 3

Репутация:
0
±

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

Excel 2010

уж простите моя глупость, но никак не могу понять в какое место Вашего макроса вставить FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Ответить

Источник

Heroes

1 / 1 / 0

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

Сообщений: 93

21.09.2018, 20:30. Показов 11978. Ответов 8

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

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

Visual Basic

Dim x As String
    strPath = "W:Отчетность"
    On Error Resume Next
    x = GetAttr(strPath) And 0
    If Err = 0 Then
        strDate = Format(Now, "dd-mm-yy hh-mm")
        FileNameXls = strPath & "" & "Отчет" & " " & strDate & ".xlsx"
        ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
    Else
        MsgBox " " & strPath & " ", vbCritical
    End If

Есть способ сохранить КОПИЮ файла в формате .xlsx ?

~~Остап Бонд~~

Заблокирован

21.09.2018, 20:37

Sub SaveAs([Filename], [FileFormat], [Password], [WriteResPassword], [ReadOnlyRecommended], [CreateBackup], [AccessMode As XlSaveAsAccessMode = xlNoChange], [ConflictResolution], [AddToMru], [TextCodepage], [TextVisualLayout], [Local])
Member of Excel.Workbook

1 / 1 / 0

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

Сообщений: 93

21.09.2018, 21:38

[ТС]

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

Казанский

15136 / 6410 / 1730

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

Сообщений: 9,999

21.09.2018, 23:54

Сообщение было отмечено Heroes как решение

Решение

Heroes, сначала SaveCopyAs, потом открыть и сохранить в нужном формате. Допилите по необходимости.

Visual Basic

Sub ExportAsXLSX()
Const strPath = "W:Отчетность"
Dim x
  On Error GoTo 1
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  x = strPath & Format(Now, "hhmmss") & ActiveWorkbook.Name
  ActiveWorkbook.SaveCopyAs x
  With Workbooks.Open(x)
    .SaveAs strPath & Format(Now, "Отчет dd-mm-yy hh-mm.xlsx"), xlOpenXMLWorkbook
    .Close 0
  End With
  Kill x
1 Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

GetAttr(strPath) And 0 всегда будет 0.

6875 / 2807 / 533

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

Сообщений: 8,562

22.09.2018, 18:41

Если меняете формат (да ещё и содержимое) — как это может быть КОПИЕЙ?

1 / 1 / 0

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

Сообщений: 93

22.09.2018, 21:21

[ТС]

Сообщение от Hugo121

Если меняете формат (да ещё и содержимое) — как это может быть КОПИЕЙ?

Ок, это Не копия,
а копия файла с заменой формата с xlsm на xlsx (содержимое например не меняется).

6875 / 2807 / 533

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

Сообщений: 8,562

22.09.2018, 21:25

Ну вот потому SaveCopyAs никак и не подходит.

1 / 1 / 0

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

Сообщений: 93

22.09.2018, 21:56

[ТС]

Сообщение от Hugo121

Ну вот потому SaveCopyAs никак и не подходит.

вы правы не подходит,
тогда вариант сделать SaveCopyAs, открыть эту копию, выполнить SaveAs в нужном формате, ТОлько такой вариант?
Вроде рабочий вариант, но так получается цепочка с 3- файлов(1. Исходный файл, где макрос. 2. Файл «SaveCopyAs». 3. Copy-файл в нужном формате
Если бы сделать все с цепочки 2-х файлов (1. Исходный файл, где макрос. 2. копия файла с заменой формата с xlsm на xlsx

Есть еще идеи?

6875 / 2807 / 533

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

Сообщений: 8,562

22.09.2018, 22:30

Можно не делать копию, а сразу сохранять книгу в нужном виде — но тогда эта конкретная активная книга и будет уже в другом формате, и если Вы хотите продолжать работать с нею в том первозданном виде — нужно её снова открывать. А эту — закрывать.

Источник