Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос:сохранение копии рабочей книги в определенной папке - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос:сохранение копии рабочей книги в определенной папке
Макрос:сохранение копии рабочей книги в определенной папке
VanDerGraat Дата: Вторник, 01.05.2012, 18:58 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - VanDerGraat
Дата добавления - 01.05.2012 в 18:58
Alex_ST Дата: Среда, 02.05.2012, 10:56 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 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
 
Ответить
СообщениеА Вам нужна именно нумерация?
А сохранение под именем с добавкой суффикса из даты и времени не подойдёт? Если подойдёт, то посмотрите в топике Макрос 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]

Автор - Alex_ST
Дата добавления - 02.05.2012 в 10:56
Alex_ST Дата: Среда, 02.05.2012, 12:59 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 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
 
Ответить
СообщениеВот, в обеденный перерыв сделал с автонумерацией:[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]

Автор - Alex_ST
Дата добавления - 02.05.2012 в 12:59
light26 Дата: Четверг, 03.05.2012, 00:14 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1346
Репутация: 91 ±
Замечаний: 0% ±

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


Я не волшебник. Я только учусь
 
Ответить
СообщениеВ обеденный перерыв?
Да я за обед просто набрать бы это не успел smile

Автор - light26
Дата добавления - 03.05.2012 в 00:14
VanDerGraat Дата: Четверг, 03.05.2012, 08:11 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 0% ±

Alex_ST
Огромное Вам спасибо!
 
Ответить
СообщениеAlex_ST
Огромное Вам спасибо!

Автор - VanDerGraat
Дата добавления - 03.05.2012 в 08:11
Alex_ST Дата: Четверг, 03.05.2012, 08:43 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 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
 
Ответить
СообщениеВадим, ну я же не с нуля набирал, а подпиливал свой же Макрос Save_Copy_As (в тот топик, к стати, я и этот макрос добавил чтобы "Готовое решение" было на любой вкус smile ).
А там больше всяких примочек для удобства, проверок и "защит от дурака", чем собственно главного действия - сохранения копии. А все эти прибамбасы остались практически неизменными.
VanDerGraat, пожалуйста, юзайте.
Но с суффиксом - датой и временем, ИМХО всё-таки лучше. Т.к. при сортировке в проводнике Виндов самый последний файл окажется самым нижним. А вот при обычной нумерации всё красиво будет только до тех пор, пока копий в папке будет до 10 (с суффиксами от 0 до 9).
А если больше, то сортировка в окне начнёт сбиваться (ведь она идёт по тексту в именах файлов).
Чтобы этого не было нужно ограничиться максимальным количеством копий, например в 1000 и присваивать суффиксы типа 001, 002, ..., 998, 999.
Но даже если это сделать, то опять же возникнут проблемы когда Вы через некоторое время, сохранив уже сотню копий, захотите удалить совсем старые и уже не нужные.
После такого удаления макрос начнёт нумерацию с 000 и продолжит её пока не упрётся в Ваш самый старый из оставленных не стёртыми файлов.
Так что чистить хранилище лучше только полностью.
А вот при времени и дате никаких ограничений нет. Потому я изначально макрос так и сделал.

Автор - Alex_ST
Дата добавления - 03.05.2012 в 08:43
sdart Дата: Суббота, 20.09.2014, 00:49 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - sdart
Дата добавления - 20.09.2014 в 00:49
Alex_ST Дата: Суббота, 20.09.2014, 21:57 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3198
Репутация: 606 ±
Замечаний: 0% ±

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



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

Автор - Alex_ST
Дата добавления - 20.09.2014 в 21:57
Pelena Дата: Суббота, 20.09.2014, 22:21 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 19160
Репутация: 4412 ±
Замечаний: ±

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


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениеsdart, на форуме запрещено задавать новые вопросы в чужих темах. Читайте Правила форума, создавайте свою тему в разделе ВОПРОСЫ ПО VBA. Эта тема закрыта

Автор - Pelena
Дата добавления - 20.09.2014 в 22:21
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос:сохранение копии рабочей книги в определенной папке
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!