Как доработать макрос в этой ветке форума, чтобы на уникальность проверялся только порядковый номер файла в имени. Например: в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850. При повторном открытии исходного файла текст в ячейке A1 может быть введен другой, например, Sony Bravia, копию требуется сохранить под именем: 2 Sony Bravia. Максимальный порядковый номер может быть 9999
Как доработать макрос в этой ветке форума, чтобы на уникальность проверялся только порядковый номер файла в имени. Например: в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850. При повторном открытии исходного файла текст в ячейке A1 может быть введен другой, например, Sony Bravia, копию требуется сохранить под именем: 2 Sony Bravia. Максимальный порядковый номер может быть 9999sdart
Сообщение отредактировал sdart - Суббота, 20.09.2014, 22:56
А Вы хорошо продумали такой принцип нумерации файлов? Ведь в эксплорере Виндов файлы в папке по умолчанию сортируются по имени. Значит в Вас будут идти примерно так: 0001 Nokia 0001 Samsung 0001 Sony 0002 Nokia 0002 Samsung 0002 Sony 0003 Nokia 0003 Sony 0004 Nokia
Т.е. модели будут идти в перемешку. Это очень не удобно для визуального восприятия. Особенно, если моделей с десяток, а количества по каждой модели разные. Если уж делать, то, наверное, принцип наименования файлов должен быть такой: "Название модели"&"разделитель"&"4-х значный номер" . При этом номера всегда должны быть из 4-х цифр, как я и указал в примере выше. Иначе опять будет путаница, т.к. последовательность текстовой сортировки при числе больше 10 будет такой: 1 10 100 1000 11 110 1100 12 120 1200
При применении предложенного мною принципа нумерации файлы в открываемой папке будут сгруппированы по моделям по алфавиту. А уже внутри модели - по номеру: Nokia - 0001 Nokia - 0002 Nokia - 0003 Nokia - 0004 Samsung - 0001 Samsung - 0002 Sony - 0001 Sony - 0002 Sony - 0003
А кроме этого, чтобы подправить, например, ЭТОТ МАКРОС, проблем, кажется нет кроме отсутствия сейчас свободного времени.
А Вы хорошо продумали такой принцип нумерации файлов? Ведь в эксплорере Виндов файлы в папке по умолчанию сортируются по имени. Значит в Вас будут идти примерно так: 0001 Nokia 0001 Samsung 0001 Sony 0002 Nokia 0002 Samsung 0002 Sony 0003 Nokia 0003 Sony 0004 Nokia
Т.е. модели будут идти в перемешку. Это очень не удобно для визуального восприятия. Особенно, если моделей с десяток, а количества по каждой модели разные. Если уж делать, то, наверное, принцип наименования файлов должен быть такой: "Название модели"&"разделитель"&"4-х значный номер" . При этом номера всегда должны быть из 4-х цифр, как я и указал в примере выше. Иначе опять будет путаница, т.к. последовательность текстовой сортировки при числе больше 10 будет такой: 1 10 100 1000 11 110 1100 12 120 1200
При применении предложенного мною принципа нумерации файлы в открываемой папке будут сгруппированы по моделям по алфавиту. А уже внутри модели - по номеру: Nokia - 0001 Nokia - 0002 Nokia - 0003 Nokia - 0004 Samsung - 0001 Samsung - 0002 Sony - 0001 Sony - 0002 Sony - 0003
А кроме этого, чтобы подправить, например, ЭТОТ МАКРОС, проблем, кажется нет кроме отсутствия сейчас свободного времени.Alex_ST
Предложенный Вами принцип нумерации логичнее, но мне не часто нужно будет обращаться к созданным файлам, также если файлов в окне проводника будет больше 100, то искать их, как мне кажется, всё равно будет проще поиском При нумерации мне не нужно чтобы повторялся порядковый номер. В Вашем макросе если изменяется имя, то присваивается новый порядковый номер, хотелось бы оставить уникальным порядковый номер в папке
Предложенный Вами принцип нумерации логичнее, но мне не часто нужно будет обращаться к созданным файлам, также если файлов в окне проводника будет больше 100, то искать их, как мне кажется, всё равно будет проще поиском При нумерации мне не нужно чтобы повторялся порядковый номер. В Вашем макросе если изменяется имя, то присваивается новый порядковый номер, хотелось бы оставить уникальным порядковый номер в папкеsdart
Неожиданно на работе образовалась пара часов свободного времени. Пот Ваши "хотелки", не дающие универсальности и применяемости делать не стал. Сделал так, как предлагал раньше
Вам всё равно, а мне не в пустую работать - может где-нибудь пригодиться. Выкладывать файлы с макросами с работы не могу. Поэтому выкладываю тексты процедур. Их можно разместить как в стандартном модуле самого файла, так и в Personal или вообще в какой-нибудь надстройке. Имя файла (без разделителя и индекса, конечно) задаётся в ячейке, на которую указывает имя ROOT. Его сразу задавать не обязательно. Само создастся после первого запуска процедуры как "Модель не задана", но не привязанное к ячейке. Просто перепривяжите его в диспетчере имён к той ячейке, где у Вас будут указываться названия моделей. Также в именах задастся после первого запуска разделитель по умолчанию " #". Он к ячейкам листа не привязан. Его значение тоже можно просто поменять в диспетчере имён. В именах же сохраняется и путь к папке сохранения копий. В общем, для пробы можно взять любой даже совсем пустой файл. Если не хотите настраивать имена потом, то можете это и не делать. Сами создадутся. Но пока не привяжете имя ROOT к какой-нибудь ячейке листа, копии файлов будут сохраняться с корнем "Модель не задана". Текст процедур надо скопипастить в стандартный модуль книги. В процедурах предусмотрена замена недопустимых в именах файлов символов на _ Из-за ограничений форума тексты процедур приложу в следующем посте. Пробуйте. Если не получится, вечером из дома попробую скинуть файл-пример. Но сразу предупреждаю: переделывать так, чтобы не задавало вопросов при сохранении я не буду - это нарушает логику сохранения и задания пути к папке бэкапов.
Неожиданно на работе образовалась пара часов свободного времени. Пот Ваши "хотелки", не дающие универсальности и применяемости делать не стал. Сделал так, как предлагал раньше
Вам всё равно, а мне не в пустую работать - может где-нибудь пригодиться. Выкладывать файлы с макросами с работы не могу. Поэтому выкладываю тексты процедур. Их можно разместить как в стандартном модуле самого файла, так и в Personal или вообще в какой-нибудь надстройке. Имя файла (без разделителя и индекса, конечно) задаётся в ячейке, на которую указывает имя ROOT. Его сразу задавать не обязательно. Само создастся после первого запуска процедуры как "Модель не задана", но не привязанное к ячейке. Просто перепривяжите его в диспетчере имён к той ячейке, где у Вас будут указываться названия моделей. Также в именах задастся после первого запуска разделитель по умолчанию " #". Он к ячейкам листа не привязан. Его значение тоже можно просто поменять в диспетчере имён. В именах же сохраняется и путь к папке сохранения копий. В общем, для пробы можно взять любой даже совсем пустой файл. Если не хотите настраивать имена потом, то можете это и не делать. Сами создадутся. Но пока не привяжете имя ROOT к какой-нибудь ячейке листа, копии файлов будут сохраняться с корнем "Модель не задана". Текст процедур надо скопипастить в стандартный модуль книги. В процедурах предусмотрена замена недопустимых в именах файлов символов на _ Из-за ограничений форума тексты процедур приложу в следующем посте. Пробуйте. Если не получится, вечером из дома попробую скинуть файл-пример. Но сразу предупреждаю: переделывать так, чтобы не задавало вопросов при сохранении я не буду - это нарушает логику сохранения и задания пути к папке бэкапов.Alex_ST
Sub Save_Copy_As_Name_And_Index() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As_Name_And_Index ' Author : Alex_ST ' Topic_HEADER : Сохранить копию текущего файла, запомнив папку для сохранения ' Topic_URL : http://www.excelworld.ru/forum/10-13088-111364-16-1411387691 ' DateTime : 22.09.14, 16:08 ' Purpose : Сохранение копии активного файла с автоматическим увеличением суффикса (номера копии) ' Notes1 : Путь сохранения копий запоминается в коллекции .Names рабочей книги (в именованном диапазоне) ' Notes2 : Имя файла копии составляется из корня, разделителя и индекса-суффикса. ' Корень имени файла копии задаётся В ЯЧЕЙКЕ с именем ROOT рабочей книги. ' Разделитель корня и суффикса задаётся именем DELIM в коллекции .Names книги ' Суффиксы при сохранении автоматически индексируются от 0000 до 9999 '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sDelim_in_Names = "DELIM" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sRoot_in_Names = "ROOT" ' имя элемента коллекции .Names, указывающего на ячейку, где записан корень имени файла Dim sPath$, sNameRoot$, sDelim$, sIndex$, sExp$, FileName, i% On Error Resume Next With ActiveWorkbook '------------- путь для сохранения копии файла ----------------- sPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, сохраненное под именем sPath_in_Names If Err Then sPath = .Path & "\": .Names.Add sPath_in_Names, sPath: Err.Clear ' если считать не удалось, значит путь не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sPath = Split(sPath, """")(1) ' убрать из считанного значения =" в начале и " в конце sPath = sPath & IIf(Right(sPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names '------------- корень имени сохраняемого файла (не изменяемая общая часть) ----------------- sNameRoot = .Names(sRoot_in_Names).RefersToRange.Value ' считать из коллекции .Names значение, сохраненное в ячейке с именем sRoot_in_Names If Err Then sNameRoot = "Модель не задана": .Names.Add Name:=sRoot_in_Names, RefersTo:="=""" & sNameRoot & """": Err.Clear ' если считать не удалось, значит имя ячейке присвоено не было. Создаётся имя sRoot_in_Names, не привязанное к диапазону. Ячейку, на которую указывает имя переопределить можно будет потом." sNameRoot = Replace_UnLegalChr(sNameRoot) ' заменить не допустимые в именах файлов символы '------------- разделитель между корнем и индексом в имени сохраняемого файла ----------------- sDelim = Split(.Names(sDelim_in_Names, """").Value)(1) ' считать из коллекции .Names значение, сохраненное под именем sDelim_in_Names If Err Then sDelim = " #": .Names.Add sDelim_in_Names, sDelim: Err.Clear ' если считать не удалось, значит разделитель ранее не задавался и он задаётся равным " #" sDelim = Replace_UnLegalChr(sDelim) ' заменить не допустимые в именах файлов символы на '------------- расширение имени сохраняемого файла ----------------- sExp = Right(.Name, Len(.Name) - InStrRev(.Name, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") '------------- увеличиваем в цикле индекс пока имя не станет уникальным ----------------- Do FileName = sPath & sNameRoot & sDelim & Application.Text(i, "0000") & sExp: i = i + 1 Loop While Dir(FileName) <> "" ' возврат к Do пока имя не будет уникальным в папке '------------- сохранение копии ----------------- FileName = Application.GetSaveAsFilename(InitialFileName:=FileName, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем sPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names .SaveCopyAs FileName End With End Sub Function Replace_UnLegalChr$(ByVal sFileName$) ' замена не допустимых символов в именах файлов Const sUnLegalChr$ = "/\:*?<>|""" ' символы, не допустимые в именах файлов Windows Dim i% For i = 1 To Len(sUnLegalChr) sFileName = Replace(sFileName, Mid(sUnLegalChr, i, 1), "_") Next Replace_UnLegalChr = sFileName End Function
[/vba]
[vba]
Код
Sub Save_Copy_As_Name_And_Index() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As_Name_And_Index ' Author : Alex_ST ' Topic_HEADER : Сохранить копию текущего файла, запомнив папку для сохранения ' Topic_URL : http://www.excelworld.ru/forum/10-13088-111364-16-1411387691 ' DateTime : 22.09.14, 16:08 ' Purpose : Сохранение копии активного файла с автоматическим увеличением суффикса (номера копии) ' Notes1 : Путь сохранения копий запоминается в коллекции .Names рабочей книги (в именованном диапазоне) ' Notes2 : Имя файла копии составляется из корня, разделителя и индекса-суффикса. ' Корень имени файла копии задаётся В ЯЧЕЙКЕ с именем ROOT рабочей книги. ' Разделитель корня и суффикса задаётся именем DELIM в коллекции .Names книги ' Суффиксы при сохранении автоматически индексируются от 0000 до 9999 '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sDelim_in_Names = "DELIM" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sRoot_in_Names = "ROOT" ' имя элемента коллекции .Names, указывающего на ячейку, где записан корень имени файла Dim sPath$, sNameRoot$, sDelim$, sIndex$, sExp$, FileName, i% On Error Resume Next With ActiveWorkbook '------------- путь для сохранения копии файла ----------------- sPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, сохраненное под именем sPath_in_Names If Err Then sPath = .Path & "\": .Names.Add sPath_in_Names, sPath: Err.Clear ' если считать не удалось, значит путь не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sPath = Split(sPath, """")(1) ' убрать из считанного значения =" в начале и " в конце sPath = sPath & IIf(Right(sPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names '------------- корень имени сохраняемого файла (не изменяемая общая часть) ----------------- sNameRoot = .Names(sRoot_in_Names).RefersToRange.Value ' считать из коллекции .Names значение, сохраненное в ячейке с именем sRoot_in_Names If Err Then sNameRoot = "Модель не задана": .Names.Add Name:=sRoot_in_Names, RefersTo:="=""" & sNameRoot & """": Err.Clear ' если считать не удалось, значит имя ячейке присвоено не было. Создаётся имя sRoot_in_Names, не привязанное к диапазону. Ячейку, на которую указывает имя переопределить можно будет потом." sNameRoot = Replace_UnLegalChr(sNameRoot) ' заменить не допустимые в именах файлов символы '------------- разделитель между корнем и индексом в имени сохраняемого файла ----------------- sDelim = Split(.Names(sDelim_in_Names, """").Value)(1) ' считать из коллекции .Names значение, сохраненное под именем sDelim_in_Names If Err Then sDelim = " #": .Names.Add sDelim_in_Names, sDelim: Err.Clear ' если считать не удалось, значит разделитель ранее не задавался и он задаётся равным " #" sDelim = Replace_UnLegalChr(sDelim) ' заменить не допустимые в именах файлов символы на '------------- расширение имени сохраняемого файла ----------------- sExp = Right(.Name, Len(.Name) - InStrRev(.Name, ".") + 1) ' расширение файла вместе с точкой (например, ".xls") '------------- увеличиваем в цикле индекс пока имя не станет уникальным ----------------- Do FileName = sPath & sNameRoot & sDelim & Application.Text(i, "0000") & sExp: i = i + 1 Loop While Dir(FileName) <> "" ' возврат к Do пока имя не будет уникальным в папке '------------- сохранение копии ----------------- FileName = Application.GetSaveAsFilename(InitialFileName:=FileName, _ FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _ Title:="Сохранение копии файла") 'задать путь сохранения и имя копии файла в окне выбора If VarType(FileName) = vbBoolean Then Exit Sub ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем sPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names .SaveCopyAs FileName End With End Sub Function Replace_UnLegalChr$(ByVal sFileName$) ' замена не допустимых символов в именах файлов Const sUnLegalChr$ = "/\:*?<>|""" ' символы, не допустимые в именах файлов Windows Dim i% For i = 1 To Len(sUnLegalChr) sFileName = Replace(sFileName, Mid(sUnLegalChr, i, 1), "_") Next Replace_UnLegalChr = sFileName End Function
Спасибо за макрос, все работает как описали. Не могу требовать большего, но если сделать нумерацию уникальной и не привязанной к ячейке, связанной с ROOT, то будет вообще прекрасно.
Спасибо за макрос, все работает как описали. Не могу требовать большего, но если сделать нумерацию уникальной и не привязанной к ячейке, связанной с ROOT, то будет вообще прекрасно.sdart
в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850.
Именно так и сделано в моих процедурах. Имя берётся из ЯЧЕЙКИ. Только ячейка эта не жёстко фиксирована на определённом листе, как Вам хотелось изначально, а на ячейку указывает имя ROOT. Поэтому процедура стала гибкой, т.к. это имя Вы можете по своему усмотрению присвоить любой ячейке на любом листе. А обещанный файл я всё-таки добил. Там все три процедуры: Сохранение копии с суффиксом "Дата-Время", Сохранение копии с суффиксом "Индекс", сохранение копии с именем из ячейки и суффиксом "Индекс".
И к стати! Уникальную и не привязанную к ячейке нумерацию копий делает макрос Save_Copy_As_Now, сохраняющий копии с суффиксом "Дата-Время"
в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850.
Именно так и сделано в моих процедурах. Имя берётся из ЯЧЕЙКИ. Только ячейка эта не жёстко фиксирована на определённом листе, как Вам хотелось изначально, а на ячейку указывает имя ROOT. Поэтому процедура стала гибкой, т.к. это имя Вы можете по своему усмотрению присвоить любой ячейке на любом листе. А обещанный файл я всё-таки добил. Там все три процедуры: Сохранение копии с суффиксом "Дата-Время", Сохранение копии с суффиксом "Индекс", сохранение копии с именем из ячейки и суффиксом "Индекс".
И к стати! Уникальную и не привязанную к ячейке нумерацию копий делает макрос Save_Copy_As_Now, сохраняющий копии с суффиксом "Дата-Время" Alex_ST
По-моему у меня не получается правильно выразить свою мысль, попробую: Имя файла должно состоять из: суффикс "Индекс" + имя из ячейки Save_Copy_As_Now не сохраняет "Индекс" Save_Copy_As_Index не обращается к ячейке Save_Copy_As_Name_And_Index не увеличивает "Индекс" при изменении значения в ячейке Нужно увеличить "Индекс" не зависимо от значения в ячейке
По-моему у меня не получается правильно выразить свою мысль, попробую: Имя файла должно состоять из: суффикс "Индекс" + имя из ячейки Save_Copy_As_Now не сохраняет "Индекс" Save_Copy_As_Index не обращается к ячейке Save_Copy_As_Name_And_Index не увеличивает "Индекс" при изменении значения в ячейке Нужно увеличить "Индекс" не зависимо от значения в ячейкеsdart
Save_Copy_As_Now сохраняет копию файла под именем, составленным из имени рабочего файла, даты и времени сохранения копии Save_Copy_As_Index сохраняет копию файла под именем, составленным из имени рабочего файла и индекса (номера копии) Save_Copy_As_Name_And_Index сохраняет копию файла под именем, составленным из имени, заданного в ячейке именованного диапазона ROOT и индекса (номера копии) А по поводу
в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850
Именно это и делает макрос Save_Copy_As_Name_And_Index (только индекс 4-значный и ставится в конце имени файла). А если Вам всё-таки нужно не изменять корень имени сохраняемого файла, то либо просто используйте Save_Copy_As_Index, либо Save_Copy_As_Name_And_Index, изменив значение имени ROOT вместо ссылки на ячейку на то постоянное, которое Вам нужно. Правда, тогда я не понимаю сути Вашего замечания:
Save_Copy_As_Name_And_Index не увеличивает "Индекс" при изменении значения в ячейке
А он и не должен этого делать. В ячейке задаётся основа (корень) имени файла. А при сохранении каждой следующей копии с такой же основой её индекс увеличивается. И после нескольких сохранений как раз и получается, что в папке сохранения копий будут лежать файлы: Nokia [0001] Nokia [0002] Nokia [0003] Nokia [0004] Samsung [0001] Samsung [0002] Sony [0001] Sony [0002] Sony [0003]
Save_Copy_As_Now сохраняет копию файла под именем, составленным из имени рабочего файла, даты и времени сохранения копии Save_Copy_As_Index сохраняет копию файла под именем, составленным из имени рабочего файла и индекса (номера копии) Save_Copy_As_Name_And_Index сохраняет копию файла под именем, составленным из имени, заданного в ячейке именованного диапазона ROOT и индекса (номера копии) А по поводу
в ячейке A1 исходного файла находится текст Samsung SA850, при выполнении макроса сохраняется копия исходного файла под именем: 1 Samsung SA850
Именно это и делает макрос Save_Copy_As_Name_And_Index (только индекс 4-значный и ставится в конце имени файла). А если Вам всё-таки нужно не изменять корень имени сохраняемого файла, то либо просто используйте Save_Copy_As_Index, либо Save_Copy_As_Name_And_Index, изменив значение имени ROOT вместо ссылки на ячейку на то постоянное, которое Вам нужно. Правда, тогда я не понимаю сути Вашего замечания:
Save_Copy_As_Name_And_Index не увеличивает "Индекс" при изменении значения в ячейке
А он и не должен этого делать. В ячейке задаётся основа (корень) имени файла. А при сохранении каждой следующей копии с такой же основой её индекс увеличивается. И после нескольких сохранений как раз и получается, что в папке сохранения копий будут лежать файлы: Nokia [0001] Nokia [0002] Nokia [0003] Nokia [0004] Samsung [0001] Samsung [0002] Sony [0001] Sony [0002] Sony [0003]Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Вторник, 23.09.2014, 08:42
К стати, sdart, уточняющие вопросы: 1. А Вы именованными диапазонами пользоваться умеете и что такое диспетчер имён представляете? 2. А как с синтаксисом VBA? Прочесть и понять процедуру с примечаниями можете?
А то может быть я зря всё это пытаюсь так подробно объяснить. Ведь я основываюсь на предположении, что уровень знаний у Вас "выше секретарши".
К стати, sdart, уточняющие вопросы: 1. А Вы именованными диапазонами пользоваться умеете и что такое диспетчер имён представляете? 2. А как с синтаксисом VBA? Прочесть и понять процедуру с примечаниями можете?
А то может быть я зря всё это пытаюсь так подробно объяснить. Ведь я основываюсь на предположении, что уровень знаний у Вас "выше секретарши".Alex_ST
Alex_ST 1,2 - ответы положительные. Поменять переменные в Ваших макросах пытался, но вылетает ошибка. Только сейчас понял почему Вы не можете меня понять. Такого наименования файлов в папке не будет Nokia [0001] Nokia [0002] Samsung [0001] Samsung [0002] Sony [0001] Модели уникальны и не повторяются, файлы в папке будут располагаться так: [0001] Nokia X1 [0002] Nokia X222 [0003] Samsung A1 [0004] Samsung A123 [0005] Sony 11 Важен только индекс, чего собственно я и хочу добиться от поведения макроса
Alex_ST 1,2 - ответы положительные. Поменять переменные в Ваших макросах пытался, но вылетает ошибка. Только сейчас понял почему Вы не можете меня понять. Такого наименования файлов в папке не будет Nokia [0001] Nokia [0002] Samsung [0001] Samsung [0002] Sony [0001] Модели уникальны и не повторяются, файлы в папке будут располагаться так: [0001] Nokia X1 [0002] Nokia X222 [0003] Samsung A1 [0004] Samsung A123 [0005] Sony 11 Важен только индекс, чего собственно я и хочу добиться от поведения макросаsdart
Сообщение отредактировал sdart - Вторник, 23.09.2014, 11:02
Кажется, понял. Но тогда всё существенно изменяется. В цикле по Dir(FileName) находить очередной индекс не надо. Вся проблема тогда в том, как по именам файлов в директории определить последний присвоенный номер чтобы по нему можно было вычислить очередной. Но это, мне кажется, достаточно сложно. По крайней мере мне сейчас с этим возиться некогда. Нужно вспоминать объектную модель и методы FileSystemObject. А я их использую очень редко и потому совсем не помню. Можно, например, в папке хранить какой-то специальный файл, в котором хранится последний присвоенный индекс. При создании каждой копии сначала открывается этот файл, индекс считывается, вычисляется новый индекс, записывается в этот файл и файл закрывается с сохранением. Опять же нужно обращаться к FileSystemObject…
Можно было бы, конечно, номер хранить где-то в файле (да хоть в тех же именах или на скрытом листе). Но тогда нужно чтобы файл-оригинал, с которого делаются копии, был в единственном экземпляре. Иначе пойдёт рассинхронизация номеров.
Кажется, понял. Но тогда всё существенно изменяется. В цикле по Dir(FileName) находить очередной индекс не надо. Вся проблема тогда в том, как по именам файлов в директории определить последний присвоенный номер чтобы по нему можно было вычислить очередной. Но это, мне кажется, достаточно сложно. По крайней мере мне сейчас с этим возиться некогда. Нужно вспоминать объектную модель и методы FileSystemObject. А я их использую очень редко и потому совсем не помню. Можно, например, в папке хранить какой-то специальный файл, в котором хранится последний присвоенный индекс. При создании каждой копии сначала открывается этот файл, индекс считывается, вычисляется новый индекс, записывается в этот файл и файл закрывается с сохранением. Опять же нужно обращаться к FileSystemObject…
Можно было бы, конечно, номер хранить где-то в файле (да хоть в тех же именах или на скрытом листе). Но тогда нужно чтобы файл-оригинал, с которого делаются копии, был в единственном экземпляре. Иначе пойдёт рассинхронизация номеров.Alex_ST
Как доработать макрос в этой ветке форума, чтобы на уникальность проверялся только порядковый номер файла в имени.
а это имел ввиду:
Цитата
Вся проблема тогда в том, как по именам файлов в директории определить последний присвоенный номер чтобы по нему можно было вычислить очередной.
Огромное спасибо Вам за готовые решения, буду копать FileSystemObject
Цитата
Можно было бы, конечно, номер хранить где-то в файле (да хоть в тех же именах или на скрытом листе). Но тогда нужно чтобы файл-оригинал, с которого делаются копии, был в единственном экземпляре. Иначе пойдёт рассинхронизация номеров.
Можно в папке создать файл и сделать его скрытым - такая реализация была бы приемлемой
Вот, в первом посте, я написал:
Цитата
Как доработать макрос в этой ветке форума, чтобы на уникальность проверялся только порядковый номер файла в имени.
а это имел ввиду:
Цитата
Вся проблема тогда в том, как по именам файлов в директории определить последний присвоенный номер чтобы по нему можно было вычислить очередной.
Огромное спасибо Вам за готовые решения, буду копать FileSystemObject
Цитата
Можно было бы, конечно, номер хранить где-то в файле (да хоть в тех же именах или на скрытом листе). Но тогда нужно чтобы файл-оригинал, с которого делаются копии, был в единственном экземпляре. Иначе пойдёт рассинхронизация номеров.
Можно в папке создать файл и сделать его скрытым - такая реализация была бы приемлемойsdart
А может быть проще перебороть свою хотелку (если она, конечно, не очень принципиальная для работы) и отказаться от суффикса-модели устройства и хранить просто файлы с именами-номерами? Тогда всё было бы элементарно просто.
А может быть проще перебороть свою хотелку (если она, конечно, не очень принципиальная для работы) и отказаться от суффикса-модели устройства и хранить просто файлы с именами-номерами? Тогда всё было бы элементарно просто.Alex_ST
В том-то и дело - нужно для работы. Сейчас открываем документ-шаблон, вписываем следующий порядковый номер(предыдущий смотрим предварительно в папке) и сохраняем копию с помощью кнопки-макроса как порядковый номер + модель. Затем открываем созданный документ и в нем работаем
В том-то и дело - нужно для работы. Сейчас открываем документ-шаблон, вписываем следующий порядковый номер(предыдущий смотрим предварительно в папке) и сохраняем копию с помощью кнопки-макроса как порядковый номер + модель. Затем открываем созданный документ и в нем работаемsdart
Интересный вариант в голову пришёл. Попробуйте-ка в проводнике папки копий сделать вид "Таблица" , а потом отобразить столбец "Заголовок". А теперь примените к оригиналу этот макрос:
[vba]
Код
Sub Save_Copy_As_Index_And_Title() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As_Index_And_Title ' Author : Alex_ST ' Topic_HEADER : Макрос: сохранение копии рабочей книги c автонумерацией ' Topic_URL : http://www.excelworld.ru/forum/10-13088-111588-16-1411494472 ' DateTime : 23.09.14, 21:47 ' Purpose : Сохранение копии активного файла с автоматическим присвоением номера копии (индекса) и запоминанием папки для сохранения ' Notes1 : Путь сохранения копий запоминается в коллекции .Names рабочей книги (в именованном диапазоне) ' Notes2 : Имя файла копии - [индекс] от 0000 до 9999 ' В свойство файла копии "Название" добавляется значение из ЯЧЕЙКИ с именем ROOT рабочей книги. '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sTitle_in_Names = "TITLE" ' имя элемента коллекции .Names, указывающего на ячейку, где записан признак, заносимый в свойство "Название" Dim sPath$, sTitle0$, sTitle$, sIndex$, sExp$, FileName, i% On Error Resume Next With ActiveWorkbook '------------- запомнить и изменить свойство Title ("Название") файла оригинала --------------- sTitle0 = .BuiltinDocumentProperties("Title").Value ' сохраним оригинальное sTitle = .Names(sTitle_in_Names).RefersToRange.Value ' считать из коллекции .Names значение, сохраненное в ячейке с именем sTitle_in_Names If Err Then sTitle = "Модель не задана": .Names.Add Name:=sTitle_in_Names, RefersTo:="=""" & sTitle & """": Err.Clear ' если считать не удалось, значит имя ячейке присвоено не было. Создаётся имя sTitle_in_Names, не привязанное к диапазону. Ячейку, на которую указывает имя переопределить можно будет потом." .BuiltinDocumentProperties("Title").Value = sTitle '------------- путь для сохранения копии файла ----------------- sPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, сохраненное под именем sPath_in_Names If Err Then sPath = .Path & "\": .Names.Add sPath_in_Names, sPath: Err.Clear ' если считать не удалось, значит путь не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sPath = Split(sPath, """")(1) ' убрать из считанного значения =" в начале и " в конце sPath = sPath & IIf(Right(sPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names '------------- расширение имени сохраняемого файла ----------------- sExp = "." & Split(.Name, ".")(UBound(Split(.Name, "."))) ' расширение файла вместе с точкой (например, ".xls") '------------- увеличиваем в цикле индекс пока имя не станет уникальным ----------------- Do FileName = sPath & " [" & Application.Text(i, "0000") & "]" & sExp: i = i + 1 Loop While Dir(FileName) <> "" ' возврат к Do пока имя не будет уникальным в папке '------------- сохранение копии ----------------- REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=FileName, _ 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_ sPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names .SaveCopyAs FileName '------------- восстановить свойство Title ("Название") файла оригинала --------------- .BuiltinDocumentProperties("Title").Value = sTitle0 End With End Sub
[/vba]
Такой вариант Вам не подойдёт?
Интересный вариант в голову пришёл. Попробуйте-ка в проводнике папки копий сделать вид "Таблица" , а потом отобразить столбец "Заголовок". А теперь примените к оригиналу этот макрос:
[vba]
Код
Sub Save_Copy_As_Index_And_Title() '--------------------------------------------------------------------------------------- ' Procedure : Save_Copy_As_Index_And_Title ' Author : Alex_ST ' Topic_HEADER : Макрос: сохранение копии рабочей книги c автонумерацией ' Topic_URL : http://www.excelworld.ru/forum/10-13088-111588-16-1411494472 ' DateTime : 23.09.14, 21:47 ' Purpose : Сохранение копии активного файла с автоматическим присвоением номера копии (индекса) и запоминанием папки для сохранения ' Notes1 : Путь сохранения копий запоминается в коллекции .Names рабочей книги (в именованном диапазоне) ' Notes2 : Имя файла копии - [индекс] от 0000 до 9999 ' В свойство файла копии "Название" добавляется значение из ЯЧЕЙКИ с именем ROOT рабочей книги. '--------------------------------------------------------------------------------------- Const sPath_in_Names = "Path4SaveCopyAs" ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла Const sTitle_in_Names = "TITLE" ' имя элемента коллекции .Names, указывающего на ячейку, где записан признак, заносимый в свойство "Название" Dim sPath$, sTitle0$, sTitle$, sIndex$, sExp$, FileName, i% On Error Resume Next With ActiveWorkbook '------------- запомнить и изменить свойство Title ("Название") файла оригинала --------------- sTitle0 = .BuiltinDocumentProperties("Title").Value ' сохраним оригинальное sTitle = .Names(sTitle_in_Names).RefersToRange.Value ' считать из коллекции .Names значение, сохраненное в ячейке с именем sTitle_in_Names If Err Then sTitle = "Модель не задана": .Names.Add Name:=sTitle_in_Names, RefersTo:="=""" & sTitle & """": Err.Clear ' если считать не удалось, значит имя ячейке присвоено не было. Создаётся имя sTitle_in_Names, не привязанное к диапазону. Ячейку, на которую указывает имя переопределить можно будет потом." .BuiltinDocumentProperties("Title").Value = sTitle '------------- путь для сохранения копии файла ----------------- sPath = .Names(sPath_in_Names).Value ' считать из коллекции .Names значение, сохраненное под именем sPath_in_Names If Err Then sPath = .Path & "\": .Names.Add sPath_in_Names, sPath: Err.Clear ' если считать не удалось, значит путь не задавался и он для первого раза задаётся равным ActiveWorkbook.Path sPath = Split(sPath, """")(1) ' убрать из считанного значения =" в начале и " в конце sPath = sPath & IIf(Right(sPath, 1) = "\", "", "\") ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша) .Names(sPath_in_Names).Value = sPath ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names '------------- расширение имени сохраняемого файла ----------------- sExp = "." & Split(.Name, ".")(UBound(Split(.Name, "."))) ' расширение файла вместе с точкой (например, ".xls") '------------- увеличиваем в цикле индекс пока имя не станет уникальным ----------------- Do FileName = sPath & " [" & Application.Text(i, "0000") & "]" & sExp: i = i + 1 Loop While Dir(FileName) <> "" ' возврат к Do пока имя не будет уникальным в папке '------------- сохранение копии ----------------- REPEAT_: FileName = Application.GetSaveAsFilename(InitialFileName:=FileName, _ 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_ sPath = Left(FileName, InStrRev(FileName, "\")) ' путь к папке сохранения копий без имени файла .Names(sPath_in_Names).Value = sPath ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names .SaveCopyAs FileName '------------- восстановить свойство Title ("Название") файла оригинала --------------- .BuiltinDocumentProperties("Title").Value = sTitle0 End With End Sub
Извиняюсь за долгий ответ, света в городе не было:( Макрос сохраняет в таком виде " [0001].xls". Присваивание имени TITLE ячейки A1, результата не даёт
Извиняюсь за долгий ответ, света в городе не было:( Макрос сохраняет в таком виде " [0001].xls". Присваивание имени TITLE ячейки A1, результата не даётsdart
в проводнике папки копий сделать вид "Таблица" , а потом отобразить столбец "Заголовок"
? По умолчанию столбец "Заголовок" в проводнике скрыт. Но чтобы вывести его нужно всего 2 клика (1 ПКМ + 1 ЛКМ). Именно в столбце "Заготовок" проводника форточек отображается встроенное свойство документа "Название" (.BuiltinDocumentProperties("Title") ), которое я заполняю из ячейки, имеющей имя TITLE. ------------ Только что проверил. Всё отлично работает. Только одна тонкость: дома на Висте столбец в проводнике назывался "Заголовок", на на работе под Семёркой - "Название". Но это, наверное, Вам помешать было не должно
в проводнике папки копий сделать вид "Таблица" , а потом отобразить столбец "Заголовок"
? По умолчанию столбец "Заголовок" в проводнике скрыт. Но чтобы вывести его нужно всего 2 клика (1 ПКМ + 1 ЛКМ). Именно в столбце "Заготовок" проводника форточек отображается встроенное свойство документа "Название" (.BuiltinDocumentProperties("Title") ), которое я заполняю из ячейки, имеющей имя TITLE. ------------ Только что проверил. Всё отлично работает. Только одна тонкость: дома на Висте столбец в проводнике назывался "Заголовок", на на работе под Семёркой - "Название". Но это, наверное, Вам помешать было не должно Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 26.09.2014, 10:01
Блин %), быстро прочитав, почему-то подумал как: просто отсортировать по столбцу название Отличная реализация Только поиск по моделям в проводнике не работает
Блин %), быстро прочитав, почему-то подумал как: просто отсортировать по столбцу название Отличная реализация Только поиск по моделям в проводнике не работаетsdart
Сообщение отредактировал sdart - Пятница, 26.09.2014, 19:33