Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Вася Пупкин
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Создание удобной формы для заполнения на листе
 
#
29.05.2010 13:52:41
Здравствуйте.  
 
Есть желание создать форму для заполнения на листе, но скудные знания явно этого не позволяют... :)  
 
Я просмотрел весь форум на предмет выпадающих списков (собственно искал с условием, что данные вводятся и запоминаются но хранятся не на листе а в специальном файле на компьютере пользователя, плюс авто подбор при вводе). При этом важно что форма находится на листе.  
 
Собственно пожелания вот:  
В каждом пункте для ответа - выпадающий список Combo Box  
Выбор значения происходит как мышкой, так и подбором по любым символам введенным в список, сам список должен быть в коде VBA (никаких ссылок на диапазоны или листы).  
 
Выбор заказчика и кода  
Изначально шаблон (список) пустой.  
Необходимо создать директорию C:\Users\Имя\Documents\Pasport_Temp\.  
В этой директории хранить все введенные значения пользователем (например выбрал регион Москва, указал заказчика МВД, указал его код (или не указал), а в следующий раз когда необходимо заполнить новый шаблон, при выборе региона в поле заказчик и код, будет возможность как ввести нового заказчика так и выбрать ранее введенных из выпадающего списка).  
 
Выбор способа проведения закупа  
Принципа как и у выбора региона, одна особенность от выбора способа зависит де активация полей ДАТА.  
Например:    
Если способ = Открытый Аукцион все поля даты активны.  
Если выбран способ = Запрос котировок цен, неактивны поля объявление о допуске, торги до, результат.  
 
Выбор даты - выпадающий календарь  
Когда форма заполнена ее можно сохранить и открыть в любой момент, переслать по почте, при этом введенные данные остаются неизменны, пока пользователь не выберет или не введет новые данные.  
 
Пример (просто условная форма, без макросов) во вложении (с картинкой и пояснениями).
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 13:40:19
{quote}{login=The_Prist}{date=23.05.2010 01:20}{thema=}{post}Я бы посоветовал Вам следующее:  
-следить за предыдущими советами(по поводу использования Me);  
-следить какой Checkbox отвечает за действие(в примере Вы используете Checkbox2 на форме, а в коде обращаетесь и отслеживаете события Checkbox1).  
...{/post}{/quote}  
 
The_Prist - Прошу извинить за мою невнимательность :)  
Спасибо за помощь.
 
Перейти    
При защите листа не работают макросы, связанные с диаграммами
 
#
23.05.2010 13:09:43
Привет.  
Добавь в начале и в конце макроса снятие защиты и ее установку после выполнения макроса.  
 
   ActiveSheet.Unprotect "111"  
   Dim a As Integer  
a = Application.Range("'Калькуляционный Лист'!D40") + 3  
 
ActiveSheet.ChartObjects("Диаграмма 3").Activate  
ActiveChart.PlotArea.Select  
ActiveChart.SetSourceData Source:=Sheets("Калькуляционный Лист").Range( _  
"K3:K" & a)  
 
Range("A101").Select  
   ActiveSheet.Protect "111"  
 
Вместо "111" укажи свой пароль
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 13:02:38
{quote}{login=The_Prist}{date=23.05.2010 12:56}{thema=}{post}Упростил и добавил проверку на наличие Проверки данных на листе:  
 
...{/post}{/quote}  
 
Спасибо за помощь :)  
 
Ошибок теперь не выдает, но и не работает.
 
Перейти    
Поиск + автоматический переход в списке по первым буквам
 
#
23.05.2010 12:53:48
{quote}{login=Hugo}{date=23.05.2010 12:07}{thema=}{post}  
 
ИМХО простого селекта достаточно:  
 
Private Sub ListBox1_Click()  
'если не выбран элемент списка - выход  
   If ListBox1.ListIndex = -1 Then Exit Sub  
'переход к ячейке листа, содержащей выбранный элемент списка  
'    Cells(ListBox1.Value, stolbV).Select  
   Rows(ListBox1.Value).Select  
End Sub{/post}{/quote}  
 
Класс.    
В принципе, да, цвет не нужен, если первый столб пустой он и так подсветит выделением всю строку.  
 
Еще вопрос, если можно. Я кликнул два раза на найденный товар, форма закрылась, строка выделена. Как это сделать?
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 12:41:01
Приложение 2 Мой файл  
ZIP архив
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 12:40:13
В моем примере все замечательно заработало во всех версиях excel (2003, 2007, 2010)  
 
Приложение 1 это пример  
 
А вот в необходимом мне файле выдает ошибку:  
Run-time error '-2147417848 (80010108)':  
 
Method 'ShowInput' of object 'Validation' Failed  
 
при этом ошибку выдает только в 2003 excel, в 2010 и 2007 все работает.  
 
Приложение 2 в следующем сообщении мой файл
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 12:09:46
{quote}{login=The_Prist}{date=23.05.2010 12:06}{thema=}{post}Здравствуйте.  
Замените Me на ActiveSheet(или другой нужный лист).  
Me - это обращение к родительскому объекту. В модуле листа - это обращение к листу, в котором расположен код, в форме - к форме, в книге - к книге.  
Думаю, ошибка понятна - в данном случае объект UserForm не имеет объекта Cells...{/post}{/quote}  
 
Спасибо! Все работает.
 
Перейти    
Показать / Скрыть все подсказки к ячейкам
 
#
23.05.2010 12:02:08
Здравствуйте,  
Через проверку данных к ячейкам даются подсказки, таких ячеек на листе много, причем во многих установлены ограничения вводимых значений и выводятся сообщения об ошибках.  
 
Необходимо создать чекбокс в форме (не на листе) при наличии в чекбоксе галки подсказки выводятся, при отсутствии нет.  
 
Что странно, сделав чекбокс на самом листе в 2007 и 2010 екселе все заработало.  
Но в форме не работает ни в каком екселе. В чем ошибка?  
 
Используемый код:  
Private Sub CheckBox1_Click()  
   ActiveSheet.Unprotect "111"  
   If CheckBox1.Value Then  
               Set rng = Me.Cells.SpecialCells(xlCellTypeAllValidation)  
               For Each cel In rng.Cells  
                       With cel.Validation  
                               If .InputMessage <> "" Then .ShowInput = True  
                       End With  
               Next cel  
   Else  
               Set rng = Me.Cells.SpecialCells(xlCellTypeAllValidation)  
               For Each cel In rng.Cells  
                       With cel.Validation  
                               If .InputMessage <> "" Then .ShowInput = False  
                       End With  
               Next cel  
   End If  
   ActiveSheet.Protect "111"  
End Sub  
 
Пример во вложении...
 
Перейти    
Поиск + автоматический переход в списке по первым буквам
 
#
23.05.2010 11:48:18
{quote}{login=Hugo}{date=23.05.2010 11:27}{thema=}{post}А если колонок больше (да и на две тоже работает) - через массив, тут переделок чуть больше.{/post}{/quote}  
 
Хороший поиск.  
А как сделать что бы при выборе найденного элемента в форме, выделялась не ячейка а вся строка, сейчас выделяется ячейка в колонке остаток (С)  
И желательно чтобы выделялась цветом. Это возможно?
 
Перейти    
Копирование необходимого листа нужное количество раз.
 
#
22.05.2010 21:33:16
{quote}{login=Somebody}{date=22.05.2010 07:53}{thema=}{post}Наверное, так. См. пример{/post}{/quote}  
 
ОГРОМНОЕ СПАСИБО!  
 
Всё работает как часы.  
Чуть изменил порядок строк, под свои нужды :)  
 
   For i = 1 To SheetsToAddCount  
       Worksheets("¹(0)").Copy After:=Sheets(Sheets.Count)  
   ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1  
   ActiveSheet.Protect "111", DrawingObjects:=False, Contents:=True, Scenarios:= _  
                       False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _  
                       AllowFormattingRows:=True, AllowInsertingRows:=True, _  
                       AllowInsertingHyperlinks:=True, AllowDeletingRows:=True, AllowSorting:= _  
                       True, AllowFiltering:=True, AllowUsingPivotTables:=True  
   Next i
 
Перейти    
Ускорить работу макроса.
 
#
22.05.2010 19:23:54
{quote}{login=Somebody}{date=22.05.2010 07:21}{thema=}{post}Не за что ){/post}{/quote}  
 
:) Извиняюсь, Somebody, СПАСИБО тебе.  
И всем тоже спасибо.
 
Перейти    
Копирование необходимого листа нужное количество раз.
 
#
22.05.2010 19:15:26
Мне сегодня уже помогли с ускорением моего макроса. Но есть у меня еще один вопрос, прошу помочь еще раз.  
 
Необходимо что бы при нажатии на кнопку выходила форма в которую можно вбить количество необходимых листов  
и Лист "№(0)" копироволся необходимое количество раз.  
 
Сейчас я использую такой код, он позволяет копировать лист один раз. Но вставляет лист правильно в конец.  
 
Private Sub CommandButton13_Click()  
' Скрываем форму с кнопкой  
   UserForm3.Hide  
' Отключаем пересчет формул, клавиатуру и обновление экрана, отображаем лист №(0), запоминаем где мы сейчас      
   Application.Calculation = xlCalculationManual  
   Dim i As Integer  
   i = Sheets.Count  
   Set objActiveSheet = ActiveSheet  
   Application.EnableCancelKey = xlDisabled  
   Application.ScreenUpdating = False  
   Sheets("№(0)").Visible = -1  
   Sheets("№(0)").Copy After:=Sheets(i)  
' Включаем на листе группировку (так надо)  
   ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1  
' Включаем защиту на новом листе      
   ActiveSheet.Protect "111", DrawingObjects:=False, Contents:=True, Scenarios:= _  
       False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _  
       AllowFormattingRows:=True, AllowInsertingRows:=True, _  
       AllowInsertingHyperlinks:=True, AllowDeletingRows:=True, AllowSorting:= _  
       True, AllowFiltering:=True, AllowUsingPivotTables:=True  
' Скрываем копируемый лист обратно, возвращаемся на запомненный нами лист      
   Sheets("№(0)").Visible = 2  
   objActiveSheet.Activate  
   Application.ScreenUpdating = True  
   Application.EnableCancelKey = xlInterrupt  
   ActiveWindow.ScrollWorkbookTabs Position:=xlLast  
   Application.Calculation = xlCalculationAutomatic  
End Sub  
 
Пример во вложении.
 
Перейти    
Ускорить работу макроса.
 
#
22.05.2010 18:51:05
Igor67 - СПАСИБО Огромное! Все прекрасно работает!!! И быстро :)
 
Перейти    
Ускорить работу макроса.
 
#
22.05.2010 17:06:34
Не до конца ответил на вопрос...  
 
Имена листов-лотов всегда начинается со знака - №
 
Перейти    
Ускорить работу макроса.
 
#
22.05.2010 17:04:26
Нет  
 
В книге всегда присутствуют: листы Паспорт, СВОД, №(0) - скрыт, №(1) - начальный лист. Также добавляются листы с лотами №(2), и т.д. до 100  
 
Дополнительно ко всему что я описал сверху могут добавлять листы с произвольными названиями, для прочих записей, например для подробного тех.задания.  
 
Естественно что собирать данные нужно только с листов №(X) кроме №(0) - скрыт
 
Перейти    
Ускорить работу макроса.
 
#
22.05.2010 16:46:53
{quote}{login=Igor67}{date=22.05.2010 03:18}{thema=}{post}MaksimGlazyrin, а задачу опишите.  
Разбирать Ваш код лень, многа букофф.    
А решений по переносу информации с заданного листа по столбцам или еще как даже на нашем "юнном" форуме уже полно. Ну а функция - конечно медленная.  
проще через форму передать номер листа в переменную и через With Sheets() End With  
 
В общем прощк заново написать:){/post}{/quote}  
 
Igor67, задача перенести основные результаты расчетов с листов-лотов в сводную таблицу.  
При этом количество листов-лотов с расчетами может меняться , их могут добавлять, удалять, и изменять в них расчеты.  
А что бы данные обновлялись в сводной таблице просто нажимается кнопка "собрать данные", данные должны быть значениями.  
 
Пример во вложении, заполнены два листа лота, и пустая сводная таблица. Необходимо собрать данные определенных ячеек в сводную таблицу. Для удобства такие ячейки с данными в лотах я именовал и в сводной указал какое имя куда вставлять.  
 
Данные необходимо переносить только с листов имеющих название №(X), начиная с №(1).  
 
Делать полностью необязательно, мне будет достаточно одного живого примера.
 
Перейти    
Ускорить работу макроса.
 
#
21.05.2010 19:42:47
убрал из макроса селекты которые можно убрать.  
скорость работы не существенно увеличилась.  
 
Функция DataCollection возвращает значение из нужного именованной ячейки с листа, при этом с какого именно листа, сообщается номером из искомой строки, например строка 4:4 возвращает значение с Листа4  
 
Нашел эту функцию на форму уже не помню на каком.  
 
Если возможно что то подобное реализовать без применения формул прошу подсказать примером, желательно на моем файле хотя бы одно значение. Мне такой вариант даже больше бы подошел, т.к. я в любом случае после расчетов копирую и вставляю значения.
 
Перейти    
Ускорить работу макроса.
 
#
21.05.2010 17:50:15
Селекты уберу.  
Но они мало влияют в данном случае на скорость работы макроса.  
Отключить пересчет формул не получается, сразу вырубается функция DataCollection.  
Уже все варианты с отключением пересчета перепробовал, и отключал до удаления лишних строк а потом вставлял Calculation (пересчет), все равно выдает ошибку на функции. Без отключения пересчета все работает.
 
Перейти    
Ускорить работу макроса.
 
#
20.05.2010 22:26:21
Листов-Лотов может быть до 100, лист №(0) скрыт всегда.  
Все новые лоты получают название ярлычка №(2), №(3) и т.д.  
 
Пароль листа 111  
Сжато ZIP
 
Перейти    
Ускорить работу макроса.
 
#
20.05.2010 22:14:32
Здравствуйте, прошу помощи в изменении кода макроса, для его работы используется функция:  
Код
Public Function DataCollection(SheetNum As Integer, CellAddr As String) As Variant   
DataCollection = Sheets(SheetNum).Range(CellAddr).Value   
End Function
 
 
Сбор информации идет с листов медленно, иногда до двух минут. Необходимо либо каким то образом оптимизировать (ускорить) работу макроса, либо изменить способ сбора данных с листов.  
 
Код
Private Sub CommandButton4_Click()   
UserForm2.Hide   
If MsgBox("Будут собранны данные только с тех листов, имена которых имеет формат: №(X)" & vbCrLf & "Если вас не устраивает время работы макроса, вы можете собрать данные вручную." & vbCrLf & "Собрать данные? Операция может длиться более 1 минуты...", vbYesNo + vbInformation, "Подтверждение") = vbNo Then Exit Sub   
Application.ScreenUpdating = False   
Application.EnableCancelKey = xlDisabled   
ActiveSheet.Unprotect "111"   
Selection.AutoFilter Field:=1, Criteria1:="="   
ActiveSheet.ShowAllData   
ActiveWindow.FreezePanes = False   
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=3   
Rows("13:13").Select   
Range(Selection, Selection.End(xlDown)).Select   
Selection.Delete Shift:=xlUp   
Rows("12:12").ClearContents   
Rows("1:1").RowHeight = 3   
Rows("2:5").RowHeight = 12   
Rows("6:6").RowHeight = 3   
Rows("7:8").RowHeight = 12   
Rows("9:10").RowHeight = 3   
Rows("11:11").RowHeight = 30   
Range("A:A,J:J,P:P,V:V,AC:AC,AE:AE").ColumnWidth = 0.33   
Range("B:B").ColumnWidth = 3.71   
Range("C:C").ColumnWidth = 39   
Range("D:E,K:K,Q:Q,W:W").ColumnWidth = 13.5   
Range("F:G,I:I,L:M,O:O,R:S,U:U,X:Y,AA:AA,AD:AD").ColumnWidth = 7.29   
Range("H:H,N:N,T:T,Z:Z").ColumnWidth = 11.5   
Range("AB:AB").ColumnWidth = 29   
Range("A9:AE9").Copy: Range("A12:AE110").PasteSpecial Paste:=xlPasteFormats   
Range("B12:B112").FormulaR1C1 = "=IF(ISERROR(LEFT(MID(DataCollection(ROW(R[-8]),""NumberLot""),7,100),LEN(MID(DataCollection(ROW(R[-8]),""NumberLot""),7,100))-1)),0,LEFT(MID(DataCollection(ROW(R[-8]),""NumberLot""),7,100),LEN(MID(DataCollection(ROW(R[-8]),""NumberLot""),7,100))-1))"   
Range("C12:C112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""TitleLot"")),"""",DataCollection(ROW(R[-8]),""TitleLot""))"   
Range("D12:D112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""SumManager"")),"""",DataCollection(ROW(R[-8]),""SumManager""))"   
Range("E12:E112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""Finance"")),"""",DataCollection(ROW(R[-8]),""Finance""))"   
Range("F12:F112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MaxFixPct"")),"""",DataCollection(ROW(R[-8]),""MaxFixPct""))"   
Range("G12:G112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MaxTransPct"")+DataCollection(ROW(R[-8]),""MaxTransPct2"")),"""",DataCollection(ROW(R[-8]),""MaxTransPct"")+DataCollection(ROW(R[-8]),""MaxTransPct2""))"   
Range("H12:H112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MaxProfitSum"")),"""",DataCollection(ROW(R[-8]),""MaxProfitSum""))"   
Range("I12:I112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MaxProfitPct"")),"""",DataCollection(ROW(R[-8]),""MaxProfitPct""))"   
Range("K12:K112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MinSum"")),"""",DataCollection(ROW(R[-8]),""MinSum""))"   
Range("L12:L112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MinFixPct"")),"""",DataCollection(ROW(R[-8]),""MinFixPct""))"   
Range("M12:M112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MinTransPct"")+DataCollection(ROW(R[-8]),""MinTransPct2"")),"""",DataCollection(ROW(R[-8]),""MinTransPct"")+DataCollection(ROW(R[-8]),""MinTransPct2""))"   
Range("N12:N112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MinProfitSum"")),"""",DataCollection(ROW(R[-8]),""MinProfitSum""))"   
Range("O12:O112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""MinProfitPct"")),"""",DataCollection(ROW(R[-8]),""MinProfitPct""))"   
Range("Q12:Q112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""LimitSum"")),"""",DataCollection(ROW(R[-8]),""LimitSum""))"   
Range("R12:R112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""LimitFixPct2"")),"""",DataCollection(ROW(R[-8]),""LimitFixPct2""))"   
Range("S12:S112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""LimitTransPct"")+DataCollection(ROW(R[-8]),""LimitTransPct2"")),"""",DataCollection(ROW(R[-8]),""LimitTransPct"")+DataCollection(ROW(R[-8]),""LimitTransPct2""))"   
Range("T12:T112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""LimitProfitSum"")),"""",DataCollection(ROW(R[-8]),""LimitProfitSum""))"   
Range("U12:U112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""LimitProfitPct"")),"""",DataCollection(ROW(R[-8]),""LimitProfitPct""))"   
Range("W12:W112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""OtherSum"")),"""",DataCollection(ROW(R[-8]),""OtherSum""))"   
Range("X12:X112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""OtherFixPct2"")),"""",DataCollection(ROW(R[-8]),""OtherFixPct2""))"   
Range("Y12:Y112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""OtherTransPct"")+DataCollection(ROW(R[-8]),""OtherTransPct2"")),"""",DataCollection(ROW(R[-8]),""OtherTransPct"")+DataCollection(ROW(R[-8]),""OtherTransPct2""))"   
Range("Z12:Z112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""OtherProfitSum"")),"""",DataCollection(ROW(R[-8]),""OtherProfitSum""))"   
Range("AA12:AA112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""OtherProfitPct"")),"""",DataCollection(ROW(R[-8]),""OtherProfitPct""))"   
Range("AD12:AD112").FormulaR1C1 = "=IF(ISERROR(DataCollection(ROW(R[-8]),""ItemsLot"")),"""",DataCollection(ROW(R[-8]),""ItemsLot""))"   
Range("B12:AD12").Select   
Selection.AutoFill Destination:=Range("B12:AD110")   
Range("B12:AD112").Copy   
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False   
Selection.AutoFilter Field:=1, Criteria1:="<=0"   
Range("B12:AD112").Select   
Selection.ClearContents   
Selection.AutoFilter Field:=1   
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1   
Application.CutCopyMode = False   
Range("B12").Select   
ActiveSheet.Protect "111", DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True   
Application.EnableCancelKey = xlInterrupt   
Application.ScreenUpdating = True   
End Sub
 
 
Саму книгу не выкладываю ее вес минимум 650кб.  
 
Буду благодарен за любой совет.
 
Перейти    
Страницы: 1
Наверх