Вася Пупкин (Автор тем)

Создание удобной формы для заполнения на листе

Пользователь

Сообщений: 21 Регистрация: 01.01.1970

29.05.2010 13:52:41

Здравствуйте.

Есть желание создать форму для заполнения на листе, но скудные знания явно этого не позволяют... :)

Я просмотрел весь форум на предмет выпадающих списков (собственно искал с условием, что данные вводятся и запоминаются но хранятся не на листе а в специальном файле на компьютере пользователя, плюс авто подбор при вводе). При этом важно что форма находится на листе.

Собственно пожелания вот:
В каждом пункте для ответа - выпадающий список Combo Box
Выбор значения происходит как мышкой, так и подбором по любым символам введенным в список, сам список должен быть в коде VBA (никаких ссылок на диапазоны или листы).

Выбор заказчика и кода
Изначально шаблон (список) пустой.
Необходимо создать директорию C:\Users\Имя\Documents\Pasport_Temp\.
В этой директории хранить все введенные значения пользователем (например выбрал регион Москва, указал заказчика МВД, указал его код (или не указал), а в следующий раз когда необходимо заполнить новый шаблон, при выборе региона в поле заказчик и код, будет возможность как ввести нового заказчика так и выбрать ранее введенных из выпадающего списка).

Выбор способа проведения закупа
Принципа как и у выбора региона, одна особенность от выбора способа зависит де активация полей ДАТА.
Например:
Если способ = Открытый Аукцион все поля даты активны.
Если выбран способ = Запрос котировок цен, неактивны поля объявление о допуске, торги до, результат.

Выбор даты - выпадающий календарь
Когда форма заполнена ее можно сохранить и открыть в любой момент, переслать по почте, при этом введенные данные остаются неизменны, пока пользователь не выберет или не введет новые данные.

Пример (просто условная форма, без макросов) во вложении (с картинкой и пояснениями).

Перейти

Показать / Скрыть все подсказки к ячейкам

MaksimGlazyrin

Пользователь

Сообщений: 21 Регистрация: 01.01.1970

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

Пример во вложении...

Перейти

Копирование необходимого листа нужное количество раз.

MaksimGlazyrin

Пользователь

Сообщений: 21 Регистрация: 01.01.1970

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

Пример во вложении.

Перейти

Ускорить работу макроса.

MaksimGlazyrin

Пользователь

Сообщений: 21 Регистрация: 01.01.1970

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кб.

Буду благодарен за любой совет.

Перейти