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

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

Сообщений: 14181
Регистрация: 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

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

Сообщений: 14181
Регистрация: 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

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

Сообщений: 14181
Регистрация: 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

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

Сообщений: 14181
Регистрация: 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 Пользователь Сообщений: 14181 Регистрация: 15.09.2012 Профессиональная разработка приложений для MS Office	SetAttr ThisWorkbook.FullName, vbReadOnly Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

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

The_Prist

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

Сообщений: 14181
Регистрация: 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 Пользователь Сообщений: 23249 Регистрация: 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>

Источник

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

Источник

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

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

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

Содержание

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

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

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

Путь определяем с помощью свойства 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.
Введите или вставьте код во вновь созданном модуле.

Источник

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

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

Ответить

Источник

Heroes

1 / 1 / 0

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

Сообщений: 93

21.09.2018, 20:30. Показов 11950. Ответов 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

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

Источник