Почему не срабатывает форма?

iam1968

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

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

31.03.2013 18:04:39

Добрый день, форумчане.
В рабочую форму на КомбоБокс4 пытаюсь прикрутить код, ввода даты без разделителей. Взял этот код с
http://planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=47142&MID=391830#message391830

Никак не получается. Как только ввожу первую цифру в этот КомбоБокс, появляется окошко
Rin-time error 450:
wrong number of arguments or invalid property assigment

Ну и в коде желтым заливается выделенная полужирным строка

Код

Private Sub ComboBox4_Change()
 Dim DatBox As Object
 Set DatBox = Me.ActiveControl
 [B] If Len(DatBox) = 2 And Right$(DatBox, 1) = "." [/B]Then DatBox = "0" & DatBox
 If Len(DatBox) = 5 And Right$(DatBox, 1) = "." Then _
 DatBox = Left$(DatBox, 3) & "0" & Right$(DatBox, 2)
 If (Len(DatBox) = 3 Or Len(DatBox) = 6) And Right$(DatBox, 1) <> "." Then
 DatBox = Left$(DatBox, Len(DatBox) - 1) & "." & Right$(DatBox, 1)
 End If
 Set DatBox = Nothing
 '
 Call CheckCombo1
 '
End Sub

Пример после максимального урезания весит 215КБ. Попробую вложить. Может пройдёт...
Подскажите, пожалуйста, в чем может быть проблема?

Не прошло. В следующем посте выложу полный код на форму.

Изменено: iam1968 - 02.04.2013 03:15:20

iam1968

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

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

31.03.2013 18:09:13

Скрытый текст

Option Explicit

Private Sub ComboBox1_Change()
Call CheckCombo1
End Sub
Private Sub ComboBox11_Change()
End Sub
Private Sub ComboBox13_Change()
End Sub
Private Sub ComboBox14_Change()
End Sub
Private Sub ComboBox2_Change()
Call CheckCombo1
End Sub

'Дальше идут 4 команды для дати народження в СВ4 (ввод даты без разделителя с предупреждением о не верном вводе). ОСТОРОЖНО, не вводить повтороно здесь Function DatBox_KeyPress(ByVal KeyAsci As Integer)
Private Sub ComboBox4_Change()
Dim DatBox As Object
Set DatBox = Me.ActiveControl
If Len(DatBox) = 2 And Right$(DatBox, 1) = "." Then DatBox = "0" & DatBox
If Len(DatBox) = 5 And Right$(DatBox, 1) = "." Then _
DatBox = Left$(DatBox, 3) & "0" & Right$(DatBox, 2)
If (Len(DatBox) = 3 Or Len(DatBox) = 6) And Right$(DatBox, 1) <> "." Then
DatBox = Left$(DatBox, Len(DatBox) - 1) & "." & Right$(DatBox, 1)
End If
Set DatBox = Nothing
'
Call CheckCombo1
'
End Sub
Private Sub ComboBox4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
ComboBox4.MaxLength = 10
KeyAscii = DatBox_KeyPress(KeyAscii)
End Sub
Function DatBox_KeyPress(ByVal KeyAsci As Integer)
Select Case KeyAsci
Case 48 To 57: DatBox_KeyPress = KeyAsci
Case 44 To 47, 58: DatBox_KeyPress = 46
Case Else: DatBox_KeyPress = 0
End Select
End Function
Private Sub ComboBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Cancl As Boolean, datText$
Dim fUsFr As Object: Set fUsFr = Me
Dim DatBox As Object: Set DatBox = Me.ActiveControl
If Len(DatBox) Then Else GoTo Cancel_
datText = Left$(DatBox.Text, 5)
If Len(datText) = 4 Then datText = Left$(datText, 3) & "0" & Right$(datText, 1)
If Len(DatBox) = 6 Then DatBox = datText
If IsDate(DatBox) Then
If datText <> Format(DatBox, "DD.MM" ;) Then GoTo err_
DatBox = Format(DatBox, "DD.MM.YYYY" ;) : GoTo Cancel_
End If
err_:
MsgBox "Не вірно введена дата!", vbExclamation, "Перевірте, будь ласка, дату"
With fUsFr.Controls(DatBox.Name)
.SelStart = 0: .SelLength = Len(DatBox.Text)
End With
Cancl = True
Cancel_:
Set DatBox = Nothing: Set fUsFr = Nothing
Cancel = Cancl
End Sub

Private Sub ComboBox5_Change()
Call CheckCombo1
End Sub
Private Sub ComboBox8_Change()
End Sub
Private Sub ComboBox9_Change()
End Sub
Private Sub CheckBox1_Click() 'Это условие для CheckBox1. Если галка есть, то значение ComboBox7 = Me.ComboBox13. Или пусто.
If Me.CheckBox1 = True Then
Me.ComboBox7 = Me.ComboBox13
Else
Me.ComboBox7 = ""
End If
End Sub

Private Sub Frame1_Click1()
End Sub
Private Sub Frame3_Click1()
End Sub
Private Sub Label10_Click1()
End Sub
Private Sub Label13_Click1()
End Sub
Private Sub Label19_Click1()
End Sub
Private Sub Label4_Click1()
End Sub

Private Sub Label9_Click1()

End Sub

Private Sub Label17_Click()

End Sub

Private Sub TextBox6_Change()
End Sub

Далее в модуле
'

Public Counter1 As Integer

Public Sub show1()
U1.show
End Sub

Sub CheckCombo1()
Dim x As Control
Counter = 0
With U1 'на U1
For Each x In .Controls
If TypeOf x Is MSForms.ComboBox Then
If x.Tag = "w" Then
If x.Value <> "" Then Counter = Counter + 1
End If
End If
Next
End With
If Counter = 5 Then Call Finder1 '"Звонок" после заполнения 4 поля с тэгом "w".
End Sub

Sub Finder1()
Dim rw As Long, i As Long, x
rw = Cells(Rows.Count, "d" ;) .End(xlUp).Row
x = 0
With U1 'на U1
For i = 2 To rw
If Cells(i, 4) = .ComboBox1 Then
If Cells(i, 5) = .ComboBox2 Then
If Cells(i, 6) = .ComboBox5 Then
If Cells(i, 7) = CDate(.ComboBox4) Then
.ListBox1.AddItem ""
.ListBox1.List(x, 0) = i
.ListBox1.List(x, 1) = Cells(i, 69) '69--номер столбца, для выведения в ListBox1 (серия +номер).
x = x + 1
End If
End If
End If
End If
Next
End With
End Sub

KuklP

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

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

E-mail и реквизиты в профиле.

31.03.2013 18:20:22

iam1968, вот странные вы люди(день дурака завтра будет, напоминаю)! Нафиг выкладывать пятистраничный листинг без файла? Нам за Вас нарисовать файл, форму, контролы, чтоб проверить, Вам помочь? Не проще ли Вам выложить файл-пример с указанием строки, где ошибка? Нам это не надо - надо Вам.

Я сам - дурнее всякого примера! ...

Юрий М

Модератор

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

Контакты см. в профиле

31.03.2013 18:33:29

Если уж и показывать код, то ведь можно его прицепить в txt-файле...
А файл почему большой? - скорее всего пытаетесь прикрепить свой рабочий файл, вместо того, чтобы создать МАЛЕНЬКИЙ файл-пример с аналогичной задачей.

iam1968 Пользователь Сообщений: 184 Регистрация: 12.02.2013	#5 31.03.2013 18:40:17 Простите. Слепил новый файл. Прикладываю. Прикрепленные файлы Без разделителей легкий.xlsm (52.19 КБ)

Юрий М Модератор Сообщений: 60982 Регистрация: 14.09.2012 Контакты см. в профиле	#6 31.03.2013 18:48:55 Да, уж... проблема с вводом даты в ОДИН КомбоБокс, а в "маленьком" файле форма на весь экран...

iam1968 Пользователь Сообщений: 184 Регистрация: 12.02.2013	#7 31.03.2013 18:58:10 Так мне и надо "на весь экран". Вернее не мне , а регистратору. Да и поудалял большую часть кода, не имеющую отношения к вопросу.

Юрий М

Модератор

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

Контакты см. в профиле

31.03.2013 19:05:30

Понятно, что Вам НЕ понятно ))
Попробую ещё раз: у Вас есть проблема всего с одним контролом (кстати, почему КомбоБокс, а не ТекстБокс?) - не получается ввести в него дату в нужном формате. Попробуйте мне объяснить - зачем всем тем, кто захочет Вам помочь, все остальные поля ввода? Почему бы не создать действительно маленький файл с маленькой формой и показать в ней неработающий код? Не цеплять рабочую форму, а только необходимое?

iam1968

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

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

31.03.2013 19:14:05

Я очень слабо разбираюсь в VBA, и мне не хотелось бы создать ситуацию, когда я чрезмерно урежу пример, кто-то потратит время на урезанный пример, даст ответ на мой вопрос на этом примере, а потом окажется, что пример ЧРЕЗМЕРНО сокращён и в нём не хватает какой-то существенной "мелочи". И придется вновь разворачивать тему и проходить всё заново.

Изменено: iam1968 - 31.03.2013 19:16:06

RAN

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

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

#10

31.03.2013 19:46:10

Затрудняюсь сказать, откуда этот код в таком виде вылез, но поясняю.
Данный код не предназначен для работы с контролами на фреймах.

Код
Set DatBox = Me.ActiveControl

было введено для оформления кода в виде функций с вызовом данной функции по нажатию любой кнопки.
У вас ActiveControl - это Frame1. Соответственно код не работает.
Более того, этот код предназначался для TextBox, и с комбо не тестировался.
Часть процедур вытащена из общего модуля в модуль формы.
Замените в оригинале все DatBox на нужный контрол и удалите

Код
Set DatBox = Me.ActiveControl

Должно заработать.
Для каждого контрола должно быть три процедуры Change, Exit и KeyPress.
Вариант 1 - под форму, без общего модуля.

PS для фрейма можно так

Код
Set DatBox = Me.ActiveControl.ActiveControl

Прикрепленные файлы

Контроль ввода данных1.xls (90 КБ)

Изменено: RAN - 31.03.2013 19:57:50

iam1968 Пользователь Сообщений: 184 Регистрация: 12.02.2013	#11 31.03.2013 20:08:06 То есть, заменяю Combo с датами на Text, удаляю указанные Вами строки. Пробуем. Спасибо. Пошёл.

iam1968

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

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

#12

31.03.2013 20:52:17

В форме и коде заменил СВ4 на TextBox7.
В коде заменил DatBox на TextBox7.
Убрал (в одном месте) Set DatBox = Me.ActiveControl.

Получилось:

Скрытый текст

Что делать?

Изменено: iam1968 - 02.04.2013 03:17:54

Юрий М

Модератор

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

Контакты см. в профиле

#13

31.03.2013 20:54:26

Цитата
iam1968 пишет: ambiguus name defected: TextBox7_KeyPress

Значит есть ЕЩЁ процедура с таким же именем, а это недопустимо.

The_Prist

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

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

Профессиональная разработка приложений для MS Office

#14

31.03.2013 20:56:07

Собственно вот они:
Private Sub TextBox7_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBox7.MaxLength = 10
KeyAscii = TextBox7_KeyPress(KeyAscii)
End Sub
Function TextBox7_KeyPress(ByVal KeyAsci As Integer)
Select Case KeyAsci
Case 48 To 57: TextBox7_KeyPress = KeyAsci
Case 44 To 47, 58: TextBox7_KeyPress = 46
Case Else: TextBox7_KeyPress = 0
End Select
End Function

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

iam1968

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

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

#15

31.03.2013 23:23:04

Получилось!

Комбобокс в форме был заменен на TextBox7.
Далее в коде DatBox был заменен на TextBox7 (не везде). Сейчас нет времени. Наверное замену DatBox на TextBox7 надо будет продолжить.

Скрытый текст

Всем спасибо. Доброй ночи.

vikttur Пользователь Сообщений: 47168 Регистрация: 15.09.2012	#16 02.04.2013 03:20:24 iam1968, в следующий раз код будет удален. Вместе с сообщениями! Вас предупреждали, что большие листинги лучше выкладывать в текстовом файле, если не хотите Excel показывать.

Читают тему