Доброго времени суток всем. Нужна помощь по следующему вопросу: на работе нам приходится часто заполнять акты демонтажа оборудования. Есть готовый простенький шаблон\заготовка, в которую вносятся необходимые данные - номер акта, дата, объект и непосредственно само оборудование. Проблема в том, что акты заполняют разные люди и номер документа вписывается "от фонаря". В результате за три года скопилось немало актов с дублирующимися номерами. Хотелось бы в дальнейшем как-то автоматизировать этот процесс. Т.е. по нажатию кнопки в документе генерируется уникальный номер и записывается в определенную ячейку. В другую ячейку вставляется текущая дата и после этого документ сохраняется в текущей папке под именем, начинающимся с генерированного номера. В идеале было бы неплохо, если в имя файла еще и дописывался небольшой текст из определенной ячейки. Я пытался решить этот вопрос самостоятельно, просмотрел несколько схожих тем на форуме и понял, что ничего не понял. Поскольку мои познания в Excel более чем скромны и сам я вряд ли смогу сделать желаемое. Может кто-нибудь поможет в этом?
Доброго времени суток всем. Нужна помощь по следующему вопросу: на работе нам приходится часто заполнять акты демонтажа оборудования. Есть готовый простенький шаблон\заготовка, в которую вносятся необходимые данные - номер акта, дата, объект и непосредственно само оборудование. Проблема в том, что акты заполняют разные люди и номер документа вписывается "от фонаря". В результате за три года скопилось немало актов с дублирующимися номерами. Хотелось бы в дальнейшем как-то автоматизировать этот процесс. Т.е. по нажатию кнопки в документе генерируется уникальный номер и записывается в определенную ячейку. В другую ячейку вставляется текущая дата и после этого документ сохраняется в текущей папке под именем, начинающимся с генерированного номера. В идеале было бы неплохо, если в имя файла еще и дописывался небольшой текст из определенной ячейки. Я пытался решить этот вопрос самостоятельно, просмотрел несколько схожих тем на форуме и понял, что ничего не понял. Поскольку мои познания в Excel более чем скромны и сам я вряд ли смогу сделать желаемое. Может кто-нибудь поможет в этом?VladKovaly
VladKovaly, Надо придумать этот номер акта, каким он должен быть)) и как гарантировать его уникальность. самое простое что приходит на ум это числа от 1 до большогочисла. Либо это будет рандомное число или группа символов и тогда надо заводить место куда их сохранять и проверять при генерации нового, чтобы не повторялись. Либо делать это рандомное число хитрым способом, например час + минута + день + рандомное_число + количество строк*на коэфициент = уникальный код. что то в таком роде. В остальном всё просто. ну и по вставлять в разные ячейки(Range("A2") = Date)
VladKovaly, Надо придумать этот номер акта, каким он должен быть)) и как гарантировать его уникальность. самое простое что приходит на ум это числа от 1 до большогочисла. Либо это будет рандомное число или группа символов и тогда надо заводить место куда их сохранять и проверять при генерации нового, чтобы не повторялись. Либо делать это рандомное число хитрым способом, например час + минута + день + рандомное_число + количество строк*на коэфициент = уникальный код. что то в таком роде. В остальном всё просто. ну и по вставлять в разные ячейки(Range("A2") = Date)Матраскин
в интернете опять кто-то не прав
Сообщение отредактировал Матраскин - Понедельник, 02.06.2014, 12:39
Sub ertert() Dim Fold As String, f As String, NomDoc As Long, t& Application.ScreenUpdating = False If Right(ThisWorkbook.Path, 1) <> "\" Then Fold = ThisWorkbook.Path & "\" Else Fold = ThisWorkbook.Path f = Dir(Fold & "*.xls*", vbNormal) Do While f <> "" If f <> ThisWorkbook.Name Then t = Val(f) If NomDoc < t Then NomDoc = t End If f = Dir() Loop NomDoc = NomDoc + 1 With Sheets("Акт демонтажа") .Range("E1").Value = NomDoc f = Format(NomDoc, "0000") & "_" & .Range("B8").Value & ".xls" End With ThisWorkbook.SaveCopyAs Filename:=Fold & f Application.ScreenUpdating = True End Sub
[/vba]
или [vba]
Код
Sub ertert() Dim Fold As String, f As String, NomDoc As Long, t& Application.ScreenUpdating = False If Right(ThisWorkbook.Path, 1) <> "\" Then Fold = ThisWorkbook.Path & "\" Else Fold = ThisWorkbook.Path f = Dir(Fold & "*.xls*", vbNormal) Do While f <> "" If f <> ThisWorkbook.Name Then t = Val(f) If NomDoc < t Then NomDoc = t End If f = Dir() Loop NomDoc = NomDoc + 1 With Sheets("Акт демонтажа") .Range("E1").Value = NomDoc f = Format(NomDoc, "0000") & "_" & .Range("B8").Value & ".xls" End With ThisWorkbook.SaveCopyAs Filename:=Fold & f Application.ScreenUpdating = True End Sub
RAN, nilem, - спасибо. Это практически то, что нужно. Единственное, что слегка смущает - это два момента: слишком большое количество цифр в сгенерированном номере и наличие кнопки сохранения в копиях. Тут, на форуме, я нашел в одной теме подходящий код, но сколько ни пытался вставить его к себе - Эксель выдает ошибку. Хотел вставить команду удаления кнопки генерации из сохраненной копии документа.
Sub copiya() Dim Fname As String Application.ScreenUpdating = False Fname = "C:\" & Sheets("Лист1").Range("A1").Value & Range("B1").Text & "_" & Format(Date, "DD-MM-YYYY") & ".xlsx" 'Здесь можно указать путь и имя копии файла Sheets(Array("Лист1", "Лист2")).Copy 'Здесь можно указать листы, которые будут сохраняться в копии файла Sheets("Лист1").Range("E1").Value = Format(Date, "dd.mm.yyyy") ActiveSheet.DrawingObjects.Delete 'удаление всех кнопок With ActiveWorkbook Application.DisplayAlerts = False .SaveAs Filename:=Fname Application.ScreenUpdating = True Application.DisplayAlerts = True .Close End With End Sub
Естественно - я указывал свои адреса ячеек, но тем не менее... Увы.
RAN, nilem, - спасибо. Это практически то, что нужно. Единственное, что слегка смущает - это два момента: слишком большое количество цифр в сгенерированном номере и наличие кнопки сохранения в копиях. Тут, на форуме, я нашел в одной теме подходящий код, но сколько ни пытался вставить его к себе - Эксель выдает ошибку. Хотел вставить команду удаления кнопки генерации из сохраненной копии документа.
Sub copiya() Dim Fname As String Application.ScreenUpdating = False Fname = "C:\" & Sheets("Лист1").Range("A1").Value & Range("B1").Text & "_" & Format(Date, "DD-MM-YYYY") & ".xlsx" 'Здесь можно указать путь и имя копии файла Sheets(Array("Лист1", "Лист2")).Copy 'Здесь можно указать листы, которые будут сохраняться в копии файла Sheets("Лист1").Range("E1").Value = Format(Date, "dd.mm.yyyy") ActiveSheet.DrawingObjects.Delete 'удаление всех кнопок With ActiveWorkbook Application.DisplayAlerts = False .SaveAs Filename:=Fname Application.ScreenUpdating = True Application.DisplayAlerts = True .Close End With End Sub
Естественно - я указывал свои адреса ячеек, но тем не менее... Увы.VladKovaly
[/vba] Если сделать случайный номер 4 значным, то резко повышается вероятность повтора номера. В этом случае используйте часть макроса nilem, проверяющую наличие файла документа в папке.
[/vba] Если сделать случайный номер 4 значным, то резко повышается вероятность повтора номера. В этом случае используйте часть макроса nilem, проверяющую наличие файла документа в папке.RAN
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
