Ввод текста из формы

[DIMAIVANOV]

На форме в одном ListBox выбирается лист, в другом ListBox
вводится значение напротив фамилии. Вопрос в том, что при добавлении
фамилии кликом на CommandButton4 Excel отключается


Private Sub CommandButton1_Click()
Dim Msg, Title, Responce As String
Dim Style
Msg = "Oioeoa caeii?eou ?aaioo? "
Style = vbYesNo + vbCritical + vbDefaultButton1
Title = "Auoia ec i?ia?aiiu"
Responce = MsgBox(Msg, Style, Title)
If Responce = vbYes Then
Unload Me
End If
End Sub
Private Sub CommandButton2_Click()
ActivateSelectedSheet
End Sub
Private Sub CommandButton3_Click()
' Aaaaaiea cia?aiey a ionoo? y?aeeo
If CStr(SpinButton1.Value) = TextBox2.Text Then
ActiveCell = SpinButton1.Value
' Unload Me
Else
MsgBox "Iai?aaeeuiia cia?aiea", vbCritical
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
End If
End Sub
Private Sub CommandButton4_Click()
If TextBox3.Value <> "" And ListBox3.ListIndex <> -1 Then
With Range(ListBox3.RowSource).Item(ListBox3.ListIndex + 1, 3)
If .Value = "" Then
.Item(1, 0).Value = TextBox3.Value
Else
.Item(1, 0).End(xlToRight).Value = TextBox3.Value
End If
End With
Else
MsgBox "Iaoea eeeeaou ia eiiieo ...", , "Ioeaea iieuciaaoaey !!!"
End If
End Sub
Private Sub CommandButton5_Click()
Dim Rw As Integer
For Rw = 1 To 45
If Cells(Rw, 2) = TextBox4.Text Then Cells(Rw, 2).Delete
Next Rw
End Sub


Private Sub ListBox3_Change()
For i = 0 To ListBox3.ListCount - 1
P = i + 1
If ListBox3.Selected(i) Then Cells(P, 2).Select
Next i
Selection.Activate
If ActiveCell.Offset(0, 1) = "" Then ActiveCell.Offset(0, 1).Activate Else: ActiveCell.End(xlToRight).Offset(0, 1).Activate
End Sub

Private Sub TextBox2_Change()
Dim NewVal As Integer
NewVal = Val(TextBox2.Text)
If NewVal >= SpinButton1.Min And _
NewVal <= SpinButton1.Max Then _
SpinButton1.Value = NewVal
End Sub
Private Sub TextBox2_Enter()
' Auaaeaiea oaenoa TextBox
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCells = TextBox2
End Sub

Private Sub UserForm_Initialize()
Dim cSheets As Integer
Dim i As Integer
cSheets = Sheets.Count
ListBox1.Clear
For i = 1 To cSheets
ListBox1.AddItem Sheets(i).Name
Next
With SpinButton1
' Ii?aaaeaiea i?aaaeia
.Min = 1
.Max = 200
' Eieoeaeecaoey
.Value = 1
TextBox2.Text = .Value
End With
ListBox3.RowSource = "A1:B45"
End Sub
Sub ActivateSelectedSheet()
If ListBox1.ListIndex > -1 Then
Sheets(ListBox1.List(ListBox1.ListIndex)).Select
End If
End Sub
Private Sub ListBox1_Click()
ListBox3.RowSource = _
Worksheets(ListBox1.Value).Range("A1:B45").Address(External:=True)
Call CommandButton2_Click
Call ListBox3_Change
End Sub
Private Sub SpinButton1_Change()
TextBox2.Text = SpinButton1.Value
End Sub

[RayShade]

Код слишком сумбурен. Русские буквы опять же кривые.

Укороти его сначала.

Для примера

Код: Выделить всё

Private Sub CommandButton1_Click()
Dim Msg, Title, Responce As String
Dim Style
Msg = "Oioeoa caeii?eou ?aaioo? "
Style = vbYesNo + vbCritical + vbDefaultButton1
Title = "Auoia ec i?ia?aiiu"
Responce = MsgBox(Msg, Style, Title)
If Responce = vbYes Then
Unload Me
End If
End Sub


Превращается в

Код: Выделить всё

Private Sub CommandButton1_Click()
if MsgBox("Oioeoa caeii?eou ?aaioo? " ,vbYesNo _
or vbCritical or vbDefaultButton1, "Auoia ec i?ia?aiiu") =vbYes Then Unload Me
End Sub


[DIMAIVANOV]

Private Sub CommandButton1_Click()
Dim Msg, Title, Responce As String
Dim Style
Msg = "Хотите закончить работу? "
Style = vbYesNo + vbCritical + vbDefaultButton1
Title = "Выход из программы"
Responce = MsgBox(Msg, Style, Title)
If Responce = vbYes Then
Unload Me
End If
End Sub
Private Sub CommandButton2_Click()
ActivateSelectedSheet
End Sub
Private Sub CommandButton3_Click()
' Введение значения в пустую ячейку
If CStr(SpinButton1.Value) = TextBox2.Text Then
ActiveCell = SpinButton1.Value
' Unload Me
Else
MsgBox "Неправильное значение", vbCritical
TextBox2.SetFocus
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
End If
End Sub
Private Sub CommandButton4_Click()
If TextBox3.Value <> "" And ListBox3.ListIndex <> -1 Then
With Range(ListBox3.RowSource).Item(ListBox3.ListIndex + 1, 3)
If .Value = "" Then
.Item(1, 0).Value = TextBox3.Value
Else
.Item(1, 0).End(xlToRight).Value = TextBox3.Value
End If
End With
Else
MsgBox "Error!"
End If
End Sub
Private Sub CommandButton5_Click()
Dim Rw As Integer
For Rw = 1 To 45
If Cells(Rw, 2) = TextBox4.Text Then Cells(Rw, 2).Delete
Next Rw
End Sub


Private Sub ListBox3_Change()
For i = 0 To ListBox3.ListCount - 1
P = i + 1
If ListBox3.Selected(i) Then Cells(P, 2).Select
Next i
Selection.Activate
If ActiveCell.Offset(0, 1) = "" Then ActiveCell.Offset(0, 1).Activate Else: ActiveCell.End(xlToRight).Offset(0, 1).Activate
End Sub

Private Sub TextBox2_Change()
Dim NewVal As Integer
NewVal = Val(TextBox2.Text)
If NewVal >= SpinButton1.Min And _
NewVal <= SpinButton1.Max Then _
SpinButton1.Value = NewVal
End Sub
Private Sub TextBox2_Enter()
' Auaaeaiea oaenoa TextBox
TextBox2.SelStart = 0
TextBox2.SelLength = Len(TextBox2.Text)
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCells = TextBox2
End Sub

Private Sub UserForm_Initialize()
Dim cSheets As Integer
Dim i As Integer
cSheets = Sheets.Count
ListBox1.Clear
For i = 1 To cSheets
ListBox1.AddItem Sheets(i).Name
Next
With SpinButton1
' Определение пределов
.Min = 1
.Max = 200
' Инициализация
.Value = 1
TextBox2.Text = .Value
End With
ListBox3.RowSource = "A1:B45"
End Sub
Sub ActivateSelectedSheet()
If ListBox1.ListIndex > -1 Then
Sheets(ListBox1.List(ListBox1.ListIndex)).Select
End If
End Sub
Private Sub ListBox1_Click()
ListBox3.RowSource = _
Worksheets(ListBox1.Value).Range("A1:B45").Address(External:=True)
Call CommandButton2_Click
Call ListBox3_Change
End Sub
Private Sub SpinButton1_Change()
TextBox2.Text = SpinButton1.Value
End Sub

Код составлен из отдельных частей, работающих без ошибок
в отдельных формах. При проверке Tools-Makros-StepInto эта
форма выдает ошибку 440 или что-то об ошивке свойства Value
обьекта Range

[GSerg]

DIMAIVANOV
Может, кто-то и возьмётся читать неотформатированный код. Но это буду не я.

[DIMAIVANOV]

Решение нушел обходным путем. Поменял значение ColumnIndex и добавил Offset.
Private Sub CommandButton4_Click()
If TextBox3.Value <> "" And ListBox3.ListIndex <> -1 Then
With Range(ListBox3.RowSource).Item(ListBox3.ListIndex + 1, 2)
If .Value = "" Then
.Item(1, 2).Value = TextBox3.Value
Selection.Cut ActiveCell.Offset(0, -1)
End If
End With
Else: MsgBox "Введите имя"
End If
Рассмотрю другие решения

[uhm]

Намекну еще прозрачнее: текст программы следует заключать в теги [ code ] [ /code ]. Для этого даже есть специальная кнопочка.