Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTemp As String
If Target.Address = "$A$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Name = strTemp
End If
End If
End Sub
Создание сложного отчета-сметы в Excel
Поэтапно:
1) надо сделать так, чтобы имя листа вводилась не переименованием листа, а введением его имени в какой-то ячейке. Я могу это сделать через макрос (http://forum.codenet.ru/showthread.php?threadid=46588) но так неинтересно: надо, чтобы это происходило в реальном времени. Ввел имя - изменилось имя листа.
2) есть массив: 3 столбца и 150-200 строк (столбцы: название мраморов, себестоимость, стоимость). Надо сделать так, чтобы при вводе с клавиатуры (из списка?) начальных букв мрамора, Excel сам "додумывал" варианты и после окончательного выбора материала - вводил в ячейку сам материал, а в соседние с ним - себестоимость и стоимость. Подобных массивов - три. Для каждого надо сделать такую фичу.
Пока что хватит....
Есть еще куча надобностей, которые я не понимаю, как сделать, так как новичок в VBA. Очень огромная просьба помочь!
1) надо сделать так, чтобы имя листа вводилась не переименованием листа, а введением его имени в какой-то ячейке. Я могу это сделать через макрос (http://forum.codenet.ru/showthread.php?threadid=46588) но так неинтересно: надо, чтобы это происходило в реальном времени. Ввел имя - изменилось имя листа.
2) есть массив: 3 столбца и 150-200 строк (столбцы: название мраморов, себестоимость, стоимость). Надо сделать так, чтобы при вводе с клавиатуры (из списка?) начальных букв мрамора, Excel сам "додумывал" варианты и после окончательного выбора материала - вводил в ячейку сам материал, а в соседние с ним - себестоимость и стоимость. Подобных массивов - три. Для каждого надо сделать такую фичу.
Пока что хватит....
Есть еще куча надобностей, которые я не понимаю, как сделать, так как новичок в VBA. Очень огромная просьба помочь!
Цитата: Dimchiko
1) надо сделать так, чтобы имя листа вводилась не переименованием листа, а введением его имени в какой-то ячейке. Я могу это сделать через макрос (http://forum.codenet.ru/showthread.php?threadid=46588) но так неинтересно: надо, чтобы это происходило в реальном времени. Ввел имя - изменилось имя листа.
Добавьте в модуль кода нужного листа код, аналогичный такому:
Код:
В примере ячейка-источник - это ячейка A1. Разумеется, можно указать любую другую.
Огромнейшее спасибо!!!!
И правда в реальном времени происходит!
И правда в реальном времени происходит!
Еще требуется, как я уже говорил, сделать список с материалами. Причем очень желательно это сделать так, как реализованно в 1С: жму на ячейку, выскакивает база товаров, выбираю нужный, кликаю 2 раза и он заносится в эту ячейку. При этом проставляется из базы его стоимость (и себестоимость).
И еще: как сделать так, чтобы при нажатии на кнопку добавлялся новый лист? Сложность еще и в том, что на копируемом листе есть форма с данными, а копировать надо лишь форму....
Еще мне надо, чтобы в определенных ячейках отображалось время создания сметы и время ее последнего сохранения. Да, это видно из свойств файла, но хотелось бы нагляднее. Это возможно?
Dimchiko, какой версией Office пользуетесь? Если 2007, то я Вам не помощник, если 2000/XP/2003, вот ряд советов.
[QUOTE=Dimchiko]... жму на ячейку, выскакивает база товаров, выбираю нужный, кликаю 2 раза и он заносится в эту ячейку...[/QUOTE]Здесь Вам поможет инструмент Проверка (меню Данные).
[QUOTE=Dimchiko]... Надо сделать так, чтобы при вводе с клавиатуры (из списка?) начальных букв мрамора, Excel сам "додумывал" варианты...[/QUOTE]Такое поведение реализуемо лишь в том случае, когда ячейка для ввода данных (название вида мрамора) расположена, во-первых, в том же столбце, что и исходный список, во-вторых, сразу после нижней ячейки списка, в-третьих, не отключена настройка Автозаполнение значений ячеек (Сервис - Параметры - Правка).
[QUOTE=Dimchiko]При этом проставляется из базы его стоимость (и себестоимость).[/QUOTE]Здесь используйте функцию рабочего листа [color=blue]ВПР()[/color], а в помощь ей - функции [color=blue]ЕСЛИ()[/color] и [color=blue]ЕОШИБКА()[/color].
[QUOTE=Dimchiko]... как сделать так, чтобы при нажатии на кнопку добавлялся новый лист?..[/QUOTE]Запустите макрорекодер и выполните нужные действия вручную. Получите код, который останется лишь немного настроить.
[QUOTE=Dimchiko]... Сложность еще и в том, что на копируемом листе есть форма с данными, а копировать надо лишь форму.[/QUOTE]После копирования можно с помощью макроса очищать содержимое ячеек с данными. Получить образец кода можно опять-таки с помощью макрорекодера.
[QUOTE=Dimchiko]... надо, чтобы в определенных ячейках отображалось время создания сметы и время ее последнего сохранения...[/QUOTE]Время создания сметы - это время создания файла или время добавления нового листа с пустой формой, или что-то ещё? А время последнего сохранения сметы - это время последнего изменения файла?
[QUOTE=Dimchiko]... жму на ячейку, выскакивает база товаров, выбираю нужный, кликаю 2 раза и он заносится в эту ячейку...[/QUOTE]Здесь Вам поможет инструмент Проверка (меню Данные).
[QUOTE=Dimchiko]... Надо сделать так, чтобы при вводе с клавиатуры (из списка?) начальных букв мрамора, Excel сам "додумывал" варианты...[/QUOTE]Такое поведение реализуемо лишь в том случае, когда ячейка для ввода данных (название вида мрамора) расположена, во-первых, в том же столбце, что и исходный список, во-вторых, сразу после нижней ячейки списка, в-третьих, не отключена настройка Автозаполнение значений ячеек (Сервис - Параметры - Правка).
[QUOTE=Dimchiko]При этом проставляется из базы его стоимость (и себестоимость).[/QUOTE]Здесь используйте функцию рабочего листа [color=blue]ВПР()[/color], а в помощь ей - функции [color=blue]ЕСЛИ()[/color] и [color=blue]ЕОШИБКА()[/color].
[QUOTE=Dimchiko]... как сделать так, чтобы при нажатии на кнопку добавлялся новый лист?..[/QUOTE]Запустите макрорекодер и выполните нужные действия вручную. Получите код, который останется лишь немного настроить.
[QUOTE=Dimchiko]... Сложность еще и в том, что на копируемом листе есть форма с данными, а копировать надо лишь форму.[/QUOTE]После копирования можно с помощью макроса очищать содержимое ячеек с данными. Получить образец кода можно опять-таки с помощью макрорекодера.
[QUOTE=Dimchiko]... надо, чтобы в определенных ячейках отображалось время создания сметы и время ее последнего сохранения...[/QUOTE]Время создания сметы - это время создания файла или время добавления нового листа с пустой формой, или что-то ещё? А время последнего сохранения сметы - это время последнего изменения файла?
Цитата: Dmitrii
Dimchiko, какой версией Office пользуетесь? Если 2007, то я Вам не помощник, если 2000/XP/2003, вот ряд советов.
Здесь Вам поможет инструмент Проверка (меню Данные).
Такое поведение реализуемо лишь в том случае, когда ячейка для ввода данных (название вида мрамора) расположена, во-первых, в том же столбце, что и исходный список, во-вторых, сразу после нижней ячейки списка, в-третьих, не отключена настройка Автозаполнение значений ячеек (Сервис - Параметры - Правка).
Здесь используйте функцию рабочего листа [color=blue]ВПР()[/color], а в помощь ей - функции [color=blue]ЕСЛИ()[/color] и [color=blue]ЕОШИБКА()[/color].
Запустите макрорекодер и выполните нужные действия вручную. Получите код, который останется лишь немного настроить.
После копирования можно с помощью макроса очищать содержимое ячеек с данными. Получить образец кода можно опять-таки с помощью макрорекодера.
Время создания сметы - это время создания файла или время добавления нового листа с пустой формой, или что-то ещё? А время последнего сохранения сметы - это время последнего изменения файла?
Здесь Вам поможет инструмент Проверка (меню Данные).
Такое поведение реализуемо лишь в том случае, когда ячейка для ввода данных (название вида мрамора) расположена, во-первых, в том же столбце, что и исходный список, во-вторых, сразу после нижней ячейки списка, в-третьих, не отключена настройка Автозаполнение значений ячеек (Сервис - Параметры - Правка).
Здесь используйте функцию рабочего листа [color=blue]ВПР()[/color], а в помощь ей - функции [color=blue]ЕСЛИ()[/color] и [color=blue]ЕОШИБКА()[/color].
Запустите макрорекодер и выполните нужные действия вручную. Получите код, который останется лишь немного настроить.
После копирования можно с помощью макроса очищать содержимое ячеек с данными. Получить образец кода можно опять-таки с помощью макрорекодера.
Время создания сметы - это время создания файла или время добавления нового листа с пустой формой, или что-то ещё? А время последнего сохранения сметы - это время последнего изменения файла?
1) К сожалению у меня 2007 excel, но не думаю, что в нем нет старых интрументов. Скорее наоборот. Хотя в меню Данные я в упор не вижу Проверки (есть "получить внешние данные", "подключения", "сортировка и фильтр", "работа с данными", "структура" и "анализ")
2) по добавлению листа есть проблема. написал макрос, но он дабавляет лишь лист определнного имени (который был записан при создании макроса), а потом при изменении имени макрос умирает
3) время создания сметы - это время, когда в нее занесен первый материал; время последнего сохранения - да. время последнего изменения.
Так. Поправочка. Данные-проверка нашел. Надо было просто добавить этот элемент в настройках Excel.
Цитата: Dimchiko
2) по добавлению листа есть проблема. написал макрос, но он дабавляет лишь лист определнного имени (который был записан при создании макроса), а потом при изменении имени макрос умирает
Попробуйте так:
Код:
Sub Example()
Worksheets("Лист1").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "Новый"
End Sub
Worksheets("Лист1").Copy After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "Новый"
End Sub
Цитата: Dimchiko
3) время создания сметы - это время, когда в нее занесен первый материал...
Каков признак этого события?
Цитата: Dimchiko
... время последнего сохранения - да. время последнего изменения.
Ответ на этот вопрос Вы можете найти здесь:
http://forum.codenet.ru/showthread.php?t=21549
Цитата: Dmitrii
Каков признак этого события?
отвечу так. в ячейке В1 пишется название сметы. и момент изменения этой ячейки = момент создания файла.
Цитата: Dmitrii
Нашел, спасибо. НО!
Внес, как было сказано в модуль ThisWorkbook и для того листа, в который внес - все работает нормально. Но при копировании листа дата уже не обновляется. На первом листе все нормально, а на скопированном - нет. А каждый раз вручную добавлять этот код невозможно, так как нужно создать шаблон сметы для широкого круга работников.
Цитата: Dimchiko
отвечу так. в ячейке В1 пишется название сметы. и момент изменения этой ячейки = момент создания файла.
Следите за событием [color=blue]Change[/color] рабочего листа. Пример такого кода уже есть в моём первом сообщении по данной теме.
Цитата: Dimchiko
Внес, как было сказано в модуль ThisWorkbook и для того листа, в который внес - все работает нормально. Но при копировании листа дата уже не обновляется. На первом листе все нормально, а на скопированном - нет. А каждый раз вручную добавлять этот код невозможно, так как нужно создать шаблон сметы для широкого круга работников.
1. При копировании рабочего листа копируется и содержимое его модуля кода. То есть, если для некоторого листа описана процедура, скажем, [color=blue]Worksheet_Change()[/color], то этот же код унаследует и копия данного листа. Впрочем, за верность такого утверждения по отношению к Excel 2007 ручаться не могу.
2. Могу предложить использование события [color=blue]Deactivate[/color] для каждого рабочего листа. Например:
Код:
Private Sub Worksheet_Deactivate()
Range("A1").Value = Now
End Sub
Range("A1").Value = Now
End Sub
Цитата: Dmitrii
Следите за событием [color=blue]Change[/color] рабочего листа. Пример такого кода уже есть в моём первом сообщении по данной теме.
[/code]
[/code]
Как-то так, то есть?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTemp As String
If Target.Address = "$B$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Range("$B$2").Value = Now 'Now()
End If
End If
End Sub
Но этот код с ошибкой....Но в чем она?
Цитата: Dmitrii
1. При копировании рабочего листа копируется и содержимое его модуля кода. То есть, если для некоторого листа описана процедура, скажем, [color=blue]Worksheet_Change()[/color], то этот же код унаследует и копия данного листа. Впрочем, за верность такого утверждения по отношению к Excel 2007 ручаться не могу.
2. Могу предложить использование события [color=blue]Deactivate[/color] для каждого рабочего листа. Например:
Код:
Private Sub Worksheet_Deactivate()
Range("A1").Value = Now
End Sub
Range("A1").Value = Now
End Sub
Не понял...
У меня на запись в ячейке времени сохранения файла стоит код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now 'Now()
End Sub
Куда дописывать Ваш код, чтобы Worksheets(1) стал как бы Worksheets(all)?
Так. С первой частью разобрался. Дело в том, что для добавления времени изменения ячейки я копировл всю процедуру. А она, видимо, не работает так. Надо просто было дописать изменение ячейки в первую процедуру!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTemp As String
If Target.Address = "$B$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Name = strTemp
ActiveSheet.Range("$B$2").Value = Now 'Now()
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTemp As String
If Target.Address = "$B$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Name = strTemp
ActiveSheet.Range("$B$2").Value = Now 'Now()
End If
End If
End Sub
Цитата: Dimchiko
... Но этот код с ошибкой....Но в чем она?
Укажите код ошибки и текст её сообщения. Однако замечу, что у меня этот код нормально работает.
Цитата: Dimchiko
Не понял...
У меня на запись в ячейке времени сохранения файла стоит код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now 'Now()
End Sub
Куда дописывать Ваш код, чтобы Worksheets(1) стал как бы Worksheets(all)?
У меня на запись в ячейке времени сохранения файла стоит код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now 'Now()
End Sub
Куда дописывать Ваш код, чтобы Worksheets(1) стал как бы Worksheets(all)?
Я предложил Вам использовать другое событие другого объекта. То есть приведённый Вами код не надо ничем дополнять.
Я бы советовал лишь немного изменить его:
Код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Range("B3").Value = Now
End Sub
ActiveSheet.Range("B3").Value = Now
End Sub
А в помощь ему надо вставить в модуль кода листа (не книги) процедуру обработки события [color=blue]Deactivate[/color]. Пусть этот лист будет в некотором смысле шаблоном, который Вы в дальнейшем будете копировать. Как уже было сказано, при копировании листа копируется и содержимое его модуля кода. То есть в модуле кода каждой копии листа-шаблона будет помещён нужный обработчик события (оно наступает при смене активного листа).
Цитата: Dmitrii
Укажите код ошибки и текст её сообщения. Однако замечу, что у меня этот код нормально работает.
Да не, я уже разобрался, спасибо. Вы правы, этот код работает, просто я его писал неверно
Цитата: Dmitrii
Я предложил Вам использовать другое событие другого объекта. То есть приведённый Вами код не надо ничем дополнять.
Я бы советовал лишь немного изменить его:
Код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Range("B3").Value = Now
End Sub
ActiveSheet.Range("B3").Value = Now
End Sub
А в помощь ему надо вставить в модуль кода листа (не книги) процедуру обработки события [color=blue]Deactivate[/color]. Пусть этот лист будет в некотором смысле шаблоном, который Вы в дальнейшем будете копировать. Как уже было сказано, при копировании листа копируется и содержимое его модуля кода. То есть в модуле кода каждой копии листа-шаблона будет помещён нужный обработчик события (оно наступает при смене активного листа).
Спасибо!! Все и правда работает! Правда есть тонкость: при многократном копировании первого листа и последующем сохранении - дата сохранения обновляется лишь на последнем листе. Но это, наверно, даже к лучшему... Но на всякий случай: как сделать так, чтобы дата последнего сохранения была ОДНОЙ НА КАЖДОМ ЛИСТЕ?
И еще маленький вопросик: у меня, если постоянно активировать/деактировать (при добавлении второго листа скакать между ними) - автоматически растет дата сохранения. Конечно, при закрытии файла без сохранения дата не изменится, и при новом запуске дата сохранения будет стоять старая. Но стоит снова начать скакать - и дата изменится снова. Это почти обесценивает данную функцию, так как проще посмотреть в свойствах файла. Она там постоянная....
[QUOTE=Dimchiko]... есть тонкость: при многократном копировании первого листа и последующем сохранении - дата сохранения обновляется лишь на последнем листе.
<...>
если постоянно активировать/деактировать (при добавлении второго листа скакать между ними) - автоматически растет дата сохранения. Конечно, при закрытии файла без сохранения дата не изменится, и при новом запуске дата сохранения будет стоять старая. Но стоит снова начать скакать - и дата изменится снова. Это почти обесценивает данную функцию, так как проще посмотреть в свойствах файла. Она там постоянная....
[/QUOTE]Было бы очень хорошо, если бы Вы сразу уточнили, что "сметой" называете не отдельный лист (как, например, это понял я), а всю рабочую книгу.
[QUOTE=Dimchiko]... как сделать так, чтобы дата последнего сохранения была ОДНОЙ НА КАЖДОМ ЛИСТЕ?[/QUOTE]
1. Удалите из модулей кода листов процедуру обработки события деактивации листа, но оставьте на месте код процедуры [color=blue]Workbook_BeforeSave()[/color], причём в исходном виде:
2. В ячейки с адресом B3 нужных листов вставьте формулу = Лист1!B3, где [color=green]Лист1[/color] - это имя первого листа книги. В таком случае макрос копирования листа может выглядеть так:
<...>
если постоянно активировать/деактировать (при добавлении второго листа скакать между ними) - автоматически растет дата сохранения. Конечно, при закрытии файла без сохранения дата не изменится, и при новом запуске дата сохранения будет стоять старая. Но стоит снова начать скакать - и дата изменится снова. Это почти обесценивает данную функцию, так как проще посмотреть в свойствах файла. Она там постоянная....
[/QUOTE]Было бы очень хорошо, если бы Вы сразу уточнили, что "сметой" называете не отдельный лист (как, например, это понял я), а всю рабочую книгу.
[QUOTE=Dimchiko]... как сделать так, чтобы дата последнего сохранения была ОДНОЙ НА КАЖДОМ ЛИСТЕ?[/QUOTE]
1. Удалите из модулей кода листов процедуру обработки события деактивации листа, но оставьте на месте код процедуры [color=blue]Workbook_BeforeSave()[/color], причём в исходном виде:
Код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now
End Sub
Worksheets(1).Range("B3").Value = Now
End Sub
2. В ячейки с адресом B3 нужных листов вставьте формулу = Лист1!B3, где [color=green]Лист1[/color] - это имя первого листа книги. В таком случае макрос копирования листа может выглядеть так:
Код:
Sub Copy_Sheet()
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "=Лист1!B3"
End Sub
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "=Лист1!B3"
End Sub
Цитата: Dmitrii
Было бы очень хорошо, если бы Вы сразу уточнили, что "сметой" называете не отдельный лист (как, например, это понял я), а всю рабочую книгу.
[/code]
[/code]
Извините....мне казалось, что все расписал подробно...
Цитата: Dmitrii
1. Удалите из модулей кода листов процедуру обработки события деактивации листа, но оставьте на месте код процедуры [color=blue]Workbook_BeforeSave()[/color], причём в исходном виде:
Код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now
End Sub
Worksheets(1).Range("B3").Value = Now
End Sub
2. В ячейки с адресом B3 нужных листов вставьте формулу = Лист1!B3, где [color=green]Лист1[/color] - это имя первого листа книги. В таком случае макрос копирования листа может выглядеть так:
Код:
Sub Copy_Sheet()
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "=Лист1!B3"
End Sub
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "=Лист1!B3"
End Sub
Дело в том, что у меня в смете может быть РАЗНОЕ КОЛИЧЕСТВО ЛИСТОВ С РАЗНЫМИ ИМЕНАМИ. Может быть и 2 листа, и 1, и 10. В связи с этим мне не совсем ясно, где именно писать = Лист1!B3? Ведь второго листа ПО УМОЛЧАНИЮ у меня нет. Задача сделать ОДИН лист сметы, с кнопкой добавления новой сметы/листа. Таскать в шаблоне 2 листа, один из которых может не использоваться - разве правильно?
Вот моя заготовка для сметы. Кнопки "добавить материал" и "добавить элемент" не работают, но очень нужны...
Итак по поводу кнопочек "добавить". Как я понимаю, нужны макросы. В связи с этим вопрос: можно ли как-то пометить строку (скажем символом *), в которой в ячейке А будет текст, начинаемый на букву м, г (мрамор/гранит), а строчку ниже (если там есть какой-то текст) метить иначе (например, **)? если ниже текста нет, то строчку метить ***. Далее макрос должен искать строку с меткой *, проверять, какая метка стоит ниже и копировать строчку * после строчки ** (добавление материала). Другой макрос должен искать строку с меткой **, копировать ее и вставлять после после последней строчки с меткой ** (вставка элемента). Правда в этом случае получается, что добавить элемент первого материала, когда уже существует второй нельзя, что не есть хорошо. Может ввести каждой строчке свой индекс и далее вставлять строчку по выбранному индексу? Или же ставим курсор в ячейку А, жмем на макрос, и он копирует строчку, ячейка А которой выделена.... Как-то так....
[QUOTE=Dimchiko]Дело в том, что у меня в смете может быть РАЗНОЕ КОЛИЧЕСТВО ЛИСТОВ С РАЗНЫМИ ИМЕНАМИ. Может быть и 2 листа, и 1, и 10. В связи с этим мне не совсем ясно, где именно писать = Лист1!B3? Ведь второго листа ПО УМОЛЧАНИЮ у меня нет. Задача сделать ОДИН лист сметы, с кнопкой добавления новой сметы/листа. Таскать в шаблоне 2 листа, один из которых может не использоваться - разве правильно?[/QUOTE]Ни количество листов, ни их имена принципиальной помехой для работы обсуждаемого макроса не являются. Нужно лишь учесть все условия задачи в коде этого макроса. Например:
Код:
Sub добавление_сметы()
Dim strWS As String, strWSNew As String
Dim blnStopFlag As Boolean, xAnswer
strWS = Worksheets(1).Name
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
If StrComp(strWS, strWSNew, vbTextCompare) <> 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
Worksheets(Worksheets.Count).Name = strWSNew
End If
End Sub
Dim strWS As String, strWSNew As String
Dim blnStopFlag As Boolean, xAnswer
strWS = Worksheets(1).Name
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
If StrComp(strWS, strWSNew, vbTextCompare) <> 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
Worksheets(Worksheets.Count).Name = strWSNew
End If
End Sub
Супер!!! Все работает как часы!!
Только немного видоизменил код:
Теперь вновь создаваемый лист копирует свое имя в ячейку В1, а из нее можно также изменить имя листа!
Только немного видоизменил код:
Код:
Sub добавление_сметы()
Dim strWS As String, strWSNew As String
Dim blnStopFlag As Boolean, xAnswer
strWS = Worksheets(1).Name
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
If StrComp(strWS, strWSNew, vbTextCompare) <> 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
ActiveSheet.Range("B1").Formula = strWSNew
Worksheets(Worksheets.Count).Name = strWSNew
End If
End Sub
Dim strWS As String, strWSNew As String
Dim blnStopFlag As Boolean, xAnswer
strWS = Worksheets(1).Name
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
If StrComp(strWS, strWSNew, vbTextCompare) <> 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
ActiveSheet.Range("B1").Formula = strWSNew
Worksheets(Worksheets.Count).Name = strWSNew
End If
End Sub
Теперь вновь создаваемый лист копирует свое имя в ячейку В1, а из нее можно также изменить имя листа!
Теперь самая большая (по сути единственная сложная) проблема в том, чтобы понять как спокойно добавлять в смету строки с материалом и элементы выбранного материала. Может изначально создавать заведомо много пустых строчек, заполнять нужное их количество, а потом макросом-кнопкой скрывать пустые? тогда можно было бы заведомо ставить сумму по материалам в определенной ячейке, ЧТО ОЧЕНЬ ВАЖНО. Но не совсем понятно, как все же это реализовать: материалов изначально может быть очень много, и, по идее, на каждый надо делать свой интервал с подсчетом суммы.... Не знаю...
[quote=Dimchiko]Теперь вновь создаваемый лист копирует свое имя в ячейку В1, а из нее можно также изменить имя листа![/quote]В таком случае выражение
ActiveSheet.Range("B1").[color=red]Formula[/color] = strWSNew стоит исправить вот так:
ActiveSheet.Range("B1").[color=green]Value[/color] = strWSNew
Кроме того, выражение Worksheets(Worksheets.Count).Name = strWSNew теперь лишнее, т.к. в модуле кода листа у Вас уже должна присутствовать процедура переименования этого листа.
[quote=Dimchiko]Теперь самая большая (по сути единственная сложная) проблема в том, чтобы понять как спокойно добавлять в смету строки с материалом и элементы выбранного материала...[/quote]Честно говоря, пока никак не пойму, что именно нужно.
Если список материалов является, так сказать, базой для составления сметы, то, полагаю, имеет смысл создать (лучше всего - на отдельном листе) некоторое подобие справочника. Для работы с его содержимым можно сделать отдельные процедуры, позволяющие добавлять, удалять, изменять строки. Для использования такого списка в инструментарии Проверка данных из соответствующей группы ячеек нужно создать именованный диапазон (тогда им можно будет пользоваться на любом листе книги).
Что же касается элементов выбранного материала, то здесь - полный туман.
Вот ещё что. В предыдущем примере процедуры [color=blue]Добавление_сметы()[/color] я забыл, что листов в книге может быть много, поэтому имя нового листа надо сравнивать с именами всех уже имеющихся листов. Например, так:
ActiveSheet.Range("B1").[color=red]Formula[/color] = strWSNew стоит исправить вот так:
ActiveSheet.Range("B1").[color=green]Value[/color] = strWSNew
Кроме того, выражение Worksheets(Worksheets.Count).Name = strWSNew теперь лишнее, т.к. в модуле кода листа у Вас уже должна присутствовать процедура переименования этого листа.
[quote=Dimchiko]Теперь самая большая (по сути единственная сложная) проблема в том, чтобы понять как спокойно добавлять в смету строки с материалом и элементы выбранного материала...[/quote]Честно говоря, пока никак не пойму, что именно нужно.
Если список материалов является, так сказать, базой для составления сметы, то, полагаю, имеет смысл создать (лучше всего - на отдельном листе) некоторое подобие справочника. Для работы с его содержимым можно сделать отдельные процедуры, позволяющие добавлять, удалять, изменять строки. Для использования такого списка в инструментарии Проверка данных из соответствующей группы ячеек нужно создать именованный диапазон (тогда им можно будет пользоваться на любом листе книги).
Что же касается элементов выбранного материала, то здесь - полный туман.
Вот ещё что. В предыдущем примере процедуры [color=blue]Добавление_сметы()[/color] я забыл, что листов в книге может быть много, поэтому имя нового листа надо сравнивать с именами всех уже имеющихся листов. Например, так:
Код:
Sub Добавление_сметы()
Dim strWSNew As String, intExists As Integer
Dim blnStopFlag As Boolean, xAnswer
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
intExists = 0
For i = 1 To Worksheets.Count
If StrComp(Worksheets(i).Name, strWSNew, vbTextCompare) = 0 Then
intExists = intExists + 1
End If
Next i
If intExists = 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
ActiveSheet.Range("B1").Value = strWSNew
End If
End Sub
Dim strWSNew As String, intExists As Integer
Dim blnStopFlag As Boolean, xAnswer
Do
strWSNew = InputBox("Имя добавляемого листа:", "Новый лист")
If Len(strWSNew) > 0 Then
intExists = 0
For i = 1 To Worksheets.Count
If StrComp(Worksheets(i).Name, strWSNew, vbTextCompare) = 0 Then
intExists = intExists + 1
End If
Next i
If intExists = 0 Then
blnStopFlag = True
Else
MsgBox "Имена листов не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя нового листа не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & strWS & "'!B3"
ActiveSheet.Range("B1").Value = strWSNew
End If
End Sub
Ваш макрос почему-то не работает. Может конфликтует с кодами листа по связи имени В1 с именем листа? Пишет, что переменная strWS пустая.
Цитата: Dimchiko
... Пишет, что переменная strWS пустая.
Приношу извинения за невнимательность.
Либо перед началом цикла добавьте строку strWS = Worksheets(1).Name, либо измените выражение
ActiveSheet.Range("B3").Formula = "='" & [color=red]strWS[/color] & "'!B3" на выражение
ActiveSheet.Range("B3").Formula = "='" & [color=green]Worksheets(1).Name[/color] & "'!B3"
Цитата: Dmitrii
Честно говоря, пока никак не пойму, что именно нужно.
Если список материалов является, так сказать, базой для составления сметы, то, полагаю, имеет смысл создать (лучше всего - на отдельном листе) некоторое подобие справочника. Для работы с его содержимым можно сделать отдельные процедуры, позволяющие добавлять, удалять, изменять строки. Для использования такого списка в инструментарии Проверка данных из соответствующей группы ячеек нужно создать именованный диапазон (тогда им можно будет пользоваться на любом листе книги).
Что же касается элементов выбранного материала, то здесь - полный туман.
Ну вот смотрите. Фирма занимается облицовкой стен, полов, лестниц натуральным камнем (мрамор, гранит). Мраморов и гранитов - очень много. У каждого своя стоимость и себестоимость. Соответственно операции по их обработке на производстве также разные как по стоимости, так и по себестоимости.
Скажем надо облицевать лестницу. Один марш. Лестница в упрощенном виде состоит из ступеней и подступенков. Бывает еще занимаемся поручнями из мрамора и облицовкой тетив, но это редко. Но суть в другом. Допустим, заказчику нужно, чтобы ступени были из мрамора 1, а подступенки из мрамора 2. Вот и получается, что мы имеем 2 материала (мрамора 1 и 2) и 2 элемента (ступень и подступенок).
Идея автоматизировать по максимуму процесс составления сметы в том, чтобы избавить сотрудников тратить на их составление 50% (!!) рабочего времени, так как задачи пересчета смет в рублях, в евро, стоимости/себестоимости, с тем или иным количеством локальных смет (скажем, сначала заказчик хочет, облицовывать пол и стены, а потом только стены, а потом только пол, а потом лестницу). В самом конце составляется общая смета (ее создание - моя головная боль ПОСЛЕ создания автоматической локальной сметы), которая будет искать в локальных сметах строчки с одинаковым значением (материалы, операции), заносить их с смету и суммировать. И также с плавающим курсом валют, скидок дизайнерам, клиентам, откатами и так далее. Все это можно автоматизировать, я уверен.
Вот такие вот пироги...
Что касается списков, то я их уже создал и успешно использую. Но проблема в том, что при создании новой сметы мы точно не знаем сколько в ней будет материалов и сколько элементов, каждого из них. Соотственно вероятность возникновения ошибок типа !ССЫЛКА (когда добавляется/стирается ряд строчек и ячейка с суммой меняет свои координаты) становится очень вероятной. А это означает снова хаос, когда 10-15 локальных смет и везде эти !ССЫЛКА.
Цитата: Dmitrii
Приношу извинения за невнимательность.
Либо перед началом цикла добавьте строку strWS = Worksheets(1).Name, либо измените выражение
ActiveSheet.Range("B3").Formula = "='" & [color=red]strWS[/color] & "'!B3" на выражение
ActiveSheet.Range("B3").Formula = "='" & [color=green]Worksheets(1).Name[/color] & "'!B3"
Либо перед началом цикла добавьте строку strWS = Worksheets(1).Name, либо измените выражение
ActiveSheet.Range("B3").Formula = "='" & [color=red]strWS[/color] & "'!B3" на выражение
ActiveSheet.Range("B3").Formula = "='" & [color=green]Worksheets(1).Name[/color] & "'!B3"
Сегодня обнаружил, что, хотя после копирования листа, в новом листе в ячейке В3 и стоит ссылка на В3 первого листа - после сохранения книги все равно все возвращается на круги своя и В3 нового листа выдает текущую дату, хотя на первом листе она не обновляется....
Цитата: Dimchiko
Сегодня обнаружил, что, хотя после копирования листа, в новом листе в ячейке В3 и стоит ссылка на В3 первого листа - после сохранения книги все равно все возвращается на круги своя и В3 нового листа выдает текущую дату, хотя на первом листе она не обновляется....
Вероятно, в модуле кода первого листа осталась процедура обработки события [color=blue]Deactivate[/color].
Цитата: Dmitrii
Вероятно, в модуле кода первого листа осталась процедура обработки события [color=blue]Deactivate[/color].
да нет, вроде.
На всех листах такой код:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strTemp As String
If Target.Address = "$B$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Name = strTemp
ActiveSheet.Range("$B$2").Value = Now 'Now()
End If
End If
End Sub
Dim strTemp As String
If Target.Address = "$B$1" Then
strTemp = CStr(Target.Value)
If Len(strTemp) > 0 Then
ActiveSheet.Name = strTemp
ActiveSheet.Range("$B$2").Value = Now 'Now()
End If
End If
End Sub
в теле книги такой:
Код:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Range("B3").Value = Now
End Sub
ActiveSheet.Range("B3").Value = Now
End Sub
а макрос такой:
Код:
Sub Добавление_сметы()
Dim strWSNew As String, intExists As Integer
Dim blnStopFlag As Boolean, xAnswer
Do
strWSNew = InputBox("Имя новой сметы:", "Новый лист")
If Len(strWSNew) > 0 Then
intExists = 0
For i = 1 To Worksheets.Count
If StrComp(Worksheets(i).Name, strWSNew, vbTextCompare) = 0 Then
intExists = intExists + 1
End If
Next i
If intExists = 0 Then
blnStopFlag = True
Else
MsgBox "Имена смет не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя новой сметы не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & Worksheets(1).Name & "'!B3"
ActiveSheet.Range("D4").Formula = "='" & Worksheets(1).Name & "'!D4"
ActiveSheet.Range("E4").Formula = "='" & Worksheets(1).Name & "'!E4"
ActiveSheet.Range("B1").Value = strWSNew
End If
End Sub
Dim strWSNew As String, intExists As Integer
Dim blnStopFlag As Boolean, xAnswer
Do
strWSNew = InputBox("Имя новой сметы:", "Новый лист")
If Len(strWSNew) > 0 Then
intExists = 0
For i = 1 To Worksheets.Count
If StrComp(Worksheets(i).Name, strWSNew, vbTextCompare) = 0 Then
intExists = intExists + 1
End If
Next i
If intExists = 0 Then
blnStopFlag = True
Else
MsgBox "Имена смет не должны совпадать.", vbCritical, "Ошибка"
End If
Else
xAnswer = MsgBox("Имя новой сметы не задано. Завершить макрос?", vbQuestion + vbYesNo, "Выбор продолжения")
If xAnswer = vbYes Then
blnStopFlag = True
End If
End If
Loop While blnStopFlag = False
If Len(strWSNew) > 0 Then
Worksheets(1).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Range("B3").Formula = "='" & Worksheets(1).Name & "'!B3"
ActiveSheet.Range("D4").Formula = "='" & Worksheets(1).Name & "'!D4"
ActiveSheet.Range("E4").Formula = "='" & Worksheets(1).Name & "'!E4"
ActiveSheet.Range("B1").Value = strWSNew
End If
End Sub
Причина оказалась на поверхности.
ТОлько на первом. Далее уже при добавлении листа ссылаемся на ячейку В3 первого листа. Все оказалось просто...:)
Код:
Код Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Range("B3").Value = Now
End Sub
Ставит текущее время на каждом листе в ячейке В3, а код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now
End Sub
ActiveSheet.Range("B3").Value = Now
End Sub
Ставит текущее время на каждом листе в ячейке В3, а код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Worksheets(1).Range("B3").Value = Now
End Sub
ТОлько на первом. Далее уже при добавлении листа ссылаемся на ячейку В3 первого листа. Все оказалось просто...:)
Я бы очень хотел организовать эти три справочника, только наверно без централизованного хранения. Хотел бы реализовать справочник на скрытом (допустим) листе. Как переходить на скрытый лист мне уже подсказали, но вот как организовать список из данных на скрытом листе?
Что касается 1С, то я сначала тоже хотел построить работу через нее. Беда в том, что и она не обеспечит нашей фирме правильность работы (работал в 1С в нескольких фирмах - постоянно падает база или еще какие проблемы)...