Листание в форме

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Листание в форме

Листание в форме

and150382

Дата: Суббота, 20.04.2013, 22:21 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

Есть форма на которой находится SpinButton. К нему был привязан код который выводил записанные данные обратно на форму.
Все работало до того момента пока не понадобилось добавить колонки в таблице. Сейчас данные заносятся обратно на форму не в те окошки из которых попали в таблицу.
Нужно поправить макрос, чтобы данные которые вносятся через форму в таблицу , заносились обратно на форму в те же окошки при нажатии SpinButton.
Помогите пожалуйста . Уже долгое время ничего не получается

К сообщению приложен файл: 6097692.rar (65.1 Kb)

Ответить

and150382

Дата: Пятница, 26.04.2013, 09:12 | Сообщение № 2

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

Вот что смог сделать.Но появилась проблема при добавлении данных в уже существующюю строку, перескакивают данные с одного столбца в другой и появляется надпись ЛОЖЬ.

Кто-нибудь помогите сделать пожалуйста.

К сообщению приложен файл: 4213858.rar (68.7 Kb)

Ответить

Матраскин

Дата: Пятница, 26.04.2013, 10:07 | Сообщение № 3

Группа: Друзья

Ранг: Обитатель

Сообщений: 375

Репутация: 81 ±

Замечаний: 0% ±

20xx

and150382, ох... что я могу сказать... тяжело )) я такое делал... но что я там делал....я как то на форме создавал отличае с помощью label и что то там выкручивал))) хах...могу скинуть тонну кода.. поковыряетесь wacko

в интернете опять кто-то не прав

Ответить

and150382

Дата: Пятница, 26.04.2013, 10:42 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

Скинте посмотрю. Выхода для меня нет, я в VBA новичок.Буду разбираться. Без этого листания никак нельзя обойтись.

Ответить

RAN

Дата: Пятница, 26.04.2013, 10:45 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Private Sub CommandButton1_Click()
     Dim iLastRow As Long
     Dim iFoundRng As Range
     Dim iBazaSht As Worksheet
     Dim iResponse As Byte

     If Me.myColumn3 = "" Then
         MsgBox "Введите информацию в поле № заказа", vbExclamation, "Ошибка"
         Exit Sub
     End If
     Set iBazaSht = ThisWorkbook.Sheets("База")    'имя листа, куда будем вносить информацию
     Set iFoundRng = iBazaSht.Columns(3).Find(what:=myColumn3.Text, LookAt:=xlWhole)    'ячейка целиком
     'Заливка ячейки при нажатии Checkbox(myColumn18), добовляем переменную х
     Dim x As Range
     'если такая запись уже есть
     If Not iFoundRng Is Nothing Then
         iResponse = MsgBox("Такой заказ уже существует.Добавить в заказ данные ?" & vbCr & vbCr & "Да - добавить данные в заказ, Нет - добавить данные на новую строку", vbYesNoCancel + vbExclamation, "Внимание!")

         If iResponse = vbYes Then
             iLastRow = iFoundRng.Row
         ElseIf iResponse = vbNo Then
             With Sheets(iBazaSht.Name)
                 iLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
             End With
         Else
             Exit Sub
         End If
     Else
         With Sheets(iBazaSht.Name)
             iLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
         End With
     End If
     With Sheets(iBazaSht.Name)
         .Cells(iLastRow, 2) = Me.myColumn2.Value
         .Cells(iLastRow, 3) = Me.myColumn3.Value

         'Заливка ячейки при нажатии Checkbox(myColumn18),заливаем ячейку зеленым если стоит галочка
         If myColumn18 Then .Cells(iLastRow, 3).Interior.ColorIndex = 10
         'очищаем Checkbox от галочки
         myColumn18 = False

         .Cells(iLastRow, 4) = Me.myColumn4.Value
         .Cells(iLastRow, 5) = Me.myColumn5.Value
         .Cells(iLastRow, 6) = Me.myColumn6.Value
         .Cells(iLastRow, 7) = Me.myColumn22.Value
         .Cells(iLastRow, 8) = Me.myColumn7.Value
         .Cells(iLastRow, 9) = Me.myColumn8.Value
         .Cells(iLastRow, 10) = Me.myColumn23.Value
         .Cells(iLastRow, 11) = Me.myColumn9.Value
         .Cells(iLastRow, 12) = Me.myColumn10.Value
         .Cells(iLastRow, 13) = Me.myColumn11.Value
         .Cells(iLastRow, 14) = Me.myColumn12.Value
         .Cells(iLastRow, 15) = Me.myColumn13.Value
         .Cells(iLastRow, 16) = Me.myColumn14.Value
         .Cells(iLastRow, 17) = Me.myColumn15.Value
         .Cells(iLastRow, 18) = Me.myColumn16.Value
         .Cells(iLastRow, 19) = Me.myColumn17.Value
         .Cells(iLastRow, 20) = Me.myColumn20.Value
         .Cells(iLastRow, 21) = Me.myColumn21.Value
         .Cells(iLastRow, 22) = Me.myColumn24.Value
         .Cells(iLastRow, 23) = Me.myColumn25.Value

     End With
     Me.myColumn2.Value = ""
     Me.myColumn3.Value = ""
     Me.myColumn4.Value = ""
     Me.myColumn5.Value = ""
     Me.myColumn6.Value = ""
     Me.myColumn7.Value = ""
     Me.myColumn8.Value = ""
     Me.myColumn9.Value = ""
     Me.myColumn10.Value = ""
     Me.myColumn11.Value = ""
     Me.myColumn12.Value = ""
     Me.myColumn13.Value = ""
     Me.myColumn14.Value = ""
     Me.myColumn15.Value = ""
     Me.myColumn16.Value = ""
     Me.myColumn17.Value = ""
     Me.myColumn20.Value = ""
     Me.myColumn21.Value = ""
     Me.myColumn22.Value = ""
     Me.myColumn23.Value = ""
     Me.myColumn24.Value = ""
     Me.myColumn25.Value = ""

     ActiveWorkbook.Save
     MsgBox "Данные добавлены!", vbInformation, "База"
     Me.myColumn2.SetFocus

End Sub

[/vba]

[vba]

Код

[/vba]

RAN

Быть или не быть, вот в чем загвоздка!

Ответить

Сообщение

[vba]

Код

[/vba]

Автор - RAN
Дата добавления - 26.04.2013 в 10:45

Матраскин

Дата: Пятница, 26.04.2013, 10:50 | Сообщение № 6

Группа: Друзья

Ранг: Обитатель

Сообщений: 375

Репутация: 81 ±

Замечаний: 0% ±

20xx

во...котан перед мной привёл какой то поменьше макрос happy

[vba]

Код

Sub Edit()
If (ActiveCell.Row > 1 And Sheets("Главная").Cells(ActiveCell.Row, 2) <> "") Then
ProfPrognoz.lblAddOrEdit = ActiveCell.Row
ProfPrognoz.Show
Else
MsgBox ("Выбирете строку, которую хотите редактировать")
End If
End Sub

Private Sub cmdSave_Click()
Dim myrow As Integer
Dim message As String, i As Integer
message = ""
myrow = CInt(lblAddOrEdit.Caption)
If (ProfPrognoz.LastName = "") Then
message = message + "Не указана фамилия!" & Chr(13)
End If

If (ProfPrognoz.FirstName = "") Then
message = message + "Не указано имя!" & Chr(13)
End If

If (ProfPrognoz.PatronymicName = "") Then
message = message + "Не указано отчество!" & Chr(13)
End If

If (ProfPrognoz.man = False And ProfPrognoz.woman = False) Then
message = message + "Не указан пол!" & Chr(13)
End If

'If (ProfPrognoz.seria = "") Then
' message = message + "Не указана серия паспорта" & Chr(13)
'End If

'If (ProfPrognoz.number = "") Then
' message = message + "Не указан номер паспорта" & Chr(13)
'End If

'If (ProfPrognoz.telefon = "") Then
' message = message + "Не указан номер телефона" & Chr(13)
'End If
If (ProfPrognoz.adres = "") Then
message = message + "Не указан адрес!" & Chr(13)
End If

If (ProfPrognoz.cbxWish.Value = "не выбрано") Then
message = message + "Не указаны профессиональные намерения учащегося!" & Chr(13)
End If
'не вводили ли раньше этого человека?
i = 3
Dim w As Boolean
w = True
While (w And i < 100)
If (Sheets("Главная").Cells(i, 2) = ProfPrognoz.LastName.Text And Sheets("Главная").Cells(i, 3) = ProfPrognoz.FirstName.Text And Sheets("Главная").Cells(i, 4) = ProfPrognoz.PatronymicName.Text And myrow = 0) Then
w = False
End If
i = i + 1
Wend
If (w) Then

If (message <> "") Then
MsgBox (message)
Else
'снять защиту с листа
Sheets("Главная").Unprotect password:="openplease"
'редактируется или добавляется запись

If (myrow <> 0) Then
'редактируется
Sheets("Главная").Cells(myrow, 2) = ProfPrognoz.LastName.Text
Sheets("Главная").Cells(myrow, 3) = ProfPrognoz.FirstName.Text
Sheets("Главная").Cells(myrow, 4) = ProfPrognoz.PatronymicName.Text
If (ProfPrognoz.man = True) Then
Sheets("Главная").Cells(myrow, 5) = "1"
Else
Sheets("Главная").Cells(myrow, 5) = "2"
End If
Sheets("Главная").Cells(myrow, 6) = ProfPrognoz.seria.Text
Sheets("Главная").Cells(myrow, 7) = ProfPrognoz.number.Text
Sheets("Главная").Cells(myrow, 8) = ProfPrognoz.adres.Text
Sheets("Главная").Cells(myrow, 9) = ProfPrognoz.telefon.Text
Select Case ProfPrognoz.cbxWish.Value
Case Is = "Планирую поступление в ВУЗ"
Sheets("Главная").Cells(myrow, 15) = 1
Case Is = "Планирую поступление в ВУЗ, но не определился с выбором специальности"
Sheets("Главная").Cells(myrow, 15) = 2
Case Is = "Планирую поступление в ССУЗ"
Sheets("Главная").Cells(myrow, 15) = 3
Case Is = "Планирую поступление в ССУЗ, но не определился с выбором специальности"
Sheets("Главная").Cells(myrow, 15) = 4
Case Is = "Планирую поступление в ПТУ"
Sheets("Главная").Cells(myrow, 15) = 5
Case Is = "Планирую поступление в ПТУ, но не определился с выбором специальности"
Sheets("Главная").Cells(myrow, 15) = 6
Case Is = "Не планирую поступление в учебное заведение"
Sheets("Главная").Cells(myrow, 15) = 7
Case Is = "Планирую дальнейшее обучение в школе, гимназии, лицее"
Sheets("Главная").Cells(myrow, 15) = 8
End Select

'------------------------------------------------------------------------
Sheets("Главная").Cells(myrow, 1) = Sheets("Общие_данные").Cells(1, 2)
Sheets("Главная").Cells(myrow, 10) = Sheets("Общие_данные").Cells(3, 2)
Sheets("Главная").Cells(myrow, 11) = Sheets("Общие_данные").Cells(6, 2)
Sheets("Главная").Cells(myrow, 12) = Sheets("Общие_данные").Cells(5, 2) & "." & Sheets("Общие_данные").Cells(5, 3) & "." & Sheets("Общие_данные").Cells(5, 4)
Sheets("Главная").Cells(myrow, 13) = Sheets("Общие_данные").Cells(2, 2)
Sheets("Главная").Cells(myrow, 14) = Sheets("Общие_данные").Cells(4, 2)

If (cbxWish.Value <> "Планирую поступление в ВУЗ") Then
Dim k As Integer
k = 0
Do While k < 50
Sheets("Главная").Cells(myrow, 16 + k) = ""
k = k + 1
Loop
End If
'поставить защиту на лист
Sheets("Главная").Protect password:="openplease", Scenarios:=True, UserInterfaceOnly:=True
Unload ProfPrognoz
Else
'найти пустую строку
i = 3
While (Sheets("Главная").Cells(i, 2) <> "" And Sheets("Главная").Cells(i, 3) <> "" And _
Sheets("Главная").Cells(i, 4) <> "")
'строка пустая
i = i + 1
Wend

'записать данные
Sheets("Главная").Cells(i, 2) = ProfPrognoz.LastName.Text
Sheets("Главная").Cells(i, 3) = ProfPrognoz.FirstName.Text
Sheets("Главная").Cells(i, 4) = ProfPrognoz.PatronymicName.Text
If (ProfPrognoz.man = True) Then
Sheets("Главная").Cells(i, 5) = "1"
Else
Sheets("Главная").Cells(i, 5) = "2"
End If
Sheets("Главная").Cells(i, 6) = ProfPrognoz.seria.Text
Sheets("Главная").Cells(i, 7) = ProfPrognoz.number.Text
Sheets("Главная").Cells(i, 8) = ProfPrognoz.adres.Text
Sheets("Главная").Cells(i, 9) = ProfPrognoz.telefon.Text
Select Case ProfPrognoz.cbxWish.Value
Case Is = "Планирую поступление в ВУЗ"
Sheets("Главная").Cells(i, 15) = 1
Case Is = "Планирую поступление в ВУЗ, но не определился с выбором специальности"
Sheets("Главная").Cells(i, 15) = 2
Case Is = "Планирую поступление в ССУЗ"
Sheets("Главная").Cells(i, 15) = 3
Case Is = "Планирую поступление в ССУЗ, но не определился с выбором специальности"
Sheets("Главная").Cells(i, 15) = 4
Case Is = "Планирую поступление в ПТУ"
Sheets("Главная").Cells(i, 15) = 5
Case Is = "Планирую поступление в ПТУ, но не определился с выбором специальности"
Sheets("Главная").Cells(i, 15) = 6
Case Is = "Не планирую поступление в учебное заведение"
Sheets("Главная").Cells(i, 15) = 7
Case Is = "Планирую дальнейшее обучение в школе, гимназии, лицее"
Sheets("Главная").Cells(i, 15) = 8
End Select
'----------------------------------------------------------
Sheets("Главная").Cells(i, 1) = Sheets("Общие_данные").Cells(1, 2)
Sheets("Главная").Cells(i, 10) = Sheets("Общие_данные").Cells(3, 2)
Sheets("Главная").Cells(i, 11) = Sheets("Общие_данные").Cells(6, 2)
Sheets("Главная").Cells(i, 12) = Sheets("Общие_данные").Cells(5, 2) & "." & Sheets("Общие_данные").Cells(5, 3) & "." & Sheets("Общие_данные").Cells(5, 4)
Sheets("Главная").Cells(i, 13) = Sheets("Общие_данные").Cells(2, 2)
Sheets("Главная").Cells(i, 14) = Sheets("Общие_данные").Cells(4, 2)

If (cbxWish.Value <> "Планирую поступление в ВУЗ" Or cbxWish.Value <> "Планирую поступление в ССУЗ") Then
k = 1
Do While k < 50
Sheets("Главная").Cells(i, 16 + k) = ""
k = k + 1
Loop
End If

'поставить защиту на лист
Sheets("Главная").Protect password:="openplease", Scenarios:=True, UserInterfaceOnly:=True
Unload ProfPrognoz
End If
End If
Else
MsgBox (ProfPrognoz.LastName.Value & " " & ProfPrognoz.FirstName.Value & " " & ProfPrognoz.PatronymicName.Value & " был(а) введен(а) раннее")
'обнулить все поля
End If
End Sub

[/vba]

во...котан перед мной привёл какой то поменьше макрос happy

[vba]

Код

[/vba]

Матраскин

в интернете опять кто-то не прав

Сообщение отредактировал Матраскин - Пятница, 26.04.2013, 10:52

Ответить

Сообщениево...котан перед мной привёл какой то поменьше макрос happy

[vba]

Код

[/vba]

Автор - Матраскин
Дата добавления - 26.04.2013 в 10:50

and150382

Дата: Пятница, 26.04.2013, 10:53 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

RAN, это то что у меня и не получается сделать) Этот код у меня стоит

Сообщение отредактировал and150382 - Пятница, 26.04.2013, 10:54

Ответить

and150382

Дата: Пятница, 26.04.2013, 11:18 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

RAN, Извините за поспешные выводы. Код то стоит, да немного не тот. Вставил ваш и всё заработало.

Ответить

and150382

Дата: Среда, 01.05.2013, 19:32 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 11

Репутация: 0 ±

Замечаний: 0% ±

Подскажите, а как сделать чтобы при открытии формы показывалась первая незаполненная строка, сейчас код перелистывания такой
[vba]

Код

Private Sub SpinButton1_SpinDown()    ' прокрутка списка  к началу базы
     If Строка > ПерваяСтрокаБД Then Строка = Строка - 1: RowChanged
End Sub
Private Sub SpinButton1_SpinUp()    ' прокрутка списка  к концу базы
     If Строка < ПоследняяСтрокаБД Then Строка = Строка + 1: RowChanged
End Sub

Sub RowChanged()    ' вызывается при изменении рабочей строки базы
     Rows(Строка).Select
     ЗаполнениеВсехПолейФормы
End Sub

Private Sub UserForm_Initialize()

If Строка < ПерваяСтрокаБД Then Строка = ПерваяСтрокаБД  ' при запуске формы начинаем просмотр с первой строки БД

     'вычисляем номер строки для последней заполненной ячейки в столбце B
     ПоследняяСтрокаБД = ThisWorkbook.Worksheets("База").Range("b" & ThisWorkbook.Worksheets("База").Rows.Count).End(xlUp).Row

     ThisWorkbook.Worksheets("База").Activate    ' активируем лист с базой
     RowChanged    ' выделяет активную строку в базе  и вызывает макрос ЗаполнениеВсехПолейФормы

[/vba]
и показывается первая строка

Ответить

RAN

Дата: Среда, 01.05.2013, 20:02 | Сообщение № 10

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Private Sub UserForm_Initialize()
Строка = ThisWorkbook.Worksheets("База").Range("b" & ThisWorkbook.Worksheets("База").Rows.Count).End(xlUp).Row + 1

[/vba]
Рекомендую
PS Кто-то глючит.
http://www.planetaexcel.ru/forum....D=25412

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Среда, 01.05.2013, 20:47

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Листание в форме

Страница 1 из 1
1