Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.54/26: Рейтинг темы: голосов - 26, средняя оценка - 4.54
R315K
6 / 6 / 0
Регистрация: 04.06.2008
Сообщений: 29
#1

Заполнение данных в листе через форму

28.09.2009, 12:23. Просмотров 4614. Ответов 12
Метки нет (Все метки)

Вообщем есть 183 форма, написанная на Excele (может кто то уже сталкивался), ввод информации в ней до ужаса не удобный(...Ввод одного символа через одну ячейку, вообщем сотрудника напрягает вводить именно таким образом(Решил попробывать написать форму ввода через vba только вот в ней определенно летаю(((...может кто нить подскажет, идеи там, буду очень благодарен
(Может как нить через TextBox?)
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
28.09.2009, 12:23
Ответы с готовыми решениями:

Разработать форму для ввода данных в таблицу на рабочем листе Excel
Форма такая: Название фильма/Жанр/Год выпуска/Страна/Продолжительность в мин.

Заполнение таблицы через форму
День добрый VBAшники! Есть одна потребность. Опишу на примере: 1. Есть...

Заполнение ячейки через форму
Есть форма через которую заполняю таблицу,подскажите как задать что она...

Программное заполнение списка на листе Excel
Есть список (элемент формы) на листе Excel. Имя списка отображается на листе...

Заполнение n-ного количества ComboBox на листе (не в форме)
Доброе время суток всем, кто сюда заглянул. Сразу спасибо, если попытаетесь мне...

12
Toxa33rus
3814 / 878 / 120
Регистрация: 16.04.2009
Сообщений: 1,766
29.09.2009, 23:29 #2
А можно для начала увидеть эту форму 183?
0
yaser
133 / 78 / 6
Регистрация: 06.04.2009
Сообщений: 192
30.09.2009, 14:45 #3
С формами в VBA работать очень просто, опишите конкретно задачу - поможем.
0
R315K
6 / 6 / 0
Регистрация: 04.06.2008
Сообщений: 29
30.09.2009, 21:36  [ТС] #4
Цитата Сообщение от Toxa33rus Посмотреть сообщение
А можно для начала увидеть эту форму 183?

Вот и форма...
Хотелось бы какой нить интерфейс на удобность ввода данных...всю голову се сломал, не могу ничего стоющего придумать(
0
Вложения
Тип файла: xls Пустая форма.xls (70.5 Кб, 137 просмотров)
Yurii_74
paladin
283 / 183 / 7
Регистрация: 25.02.2009
Сообщений: 592
01.10.2009, 14:58 #5
Можно примерно так сделать (скорее всего кто-то сможет это сделать изящнее, но принцип примерно тот же). Только для TextBox'ов надо будет ограничение длины указывать + менять стартовую ячейку.
1
Вложения
Тип файла: xls qqq.xls (92.5 Кб, 197 просмотров)
Yurii_74
paladin
283 / 183 / 7
Регистрация: 25.02.2009
Сообщений: 592
01.10.2009, 15:05 #6
Чуть не забыл. Заполнение ячеек происходит при потере фокуса TextBox'ом. Если такое проделывать при каждом изменении, то результат не очень удовлетворительный.
0
yaser
133 / 78 / 6
Регистрация: 06.04.2009
Сообщений: 192
01.10.2009, 16:48 #7
Это не форма, а обычный лист Excel с обычными ячейками.
В дополнение к решению, предложенному Yurii_74, первое, что приходит в голову - создать простую пользовательскую "настоящую" форму VBA, и заполнение полей производить по нажатию CommandButton. И лишние поля на листе не будут мешаться.
0
R315K
6 / 6 / 0
Регистрация: 04.06.2008
Сообщений: 29
01.10.2009, 17:23  [ТС] #8
Цитата Сообщение от Yurii_74 Посмотреть сообщение
Можно примерно так сделать (скорее всего кто-то сможет это сделать изящнее, но принцип примерно тот же). Только для TextBox'ов надо будет ограничение длины указывать + менять стартовую ячейку.

Спасиб за идею)...обезательно покапаюсь, это пока единственный вариант, и тем более рабочий

Добавлено через 4 минуты
Цитата Сообщение от yaser Посмотреть сообщение
Это не форма, а обычный лист Excel с обычными ячейками.
В дополнение к решению, предложенному Yurii_74, первое, что приходит в голову - создать простую пользовательскую "настоящую" форму VBA, и заполнение полей производить по нажатию CommandButton. И лишние поля на листе не будут мешаться.

Хм...интересно)
А как ты через CommandButton напишешь неподготовленный текст тут же полюбому должно использоваться TextBox...или я тут уже что то путаю?...и как соеденить кноку с выводом в ячейки?Но идея мне нравиться)
0
Toxa33rus
3814 / 878 / 120
Регистрация: 16.04.2009
Сообщений: 1,766
01.10.2009, 22:30 #9
Цитата Сообщение от Yurii_74 Посмотреть сообщение
Можно примерно так сделать...
Фу...
Я изначально хотел сделать форму аналогичную исходной но в окошке с текстбоксами но когда увидел кол-во полей то идея отпала.
И тут ко мне пришла она! Муза.
Открываете тот файл с формой, заходите в редактор макросов, делаете даблклик на "Лист1" (слева в списке листов) и вставляете это:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C
Dim R
Dim arrWords, currLen, currRow
C = Target.Column
R = Target.Row
 
If R = 15 And C = 2 Then
  If Len(Cells(15, 2).Value) > 1 Then 'если ввели текст
    arrWords = Split(UCase(Cells(15, 2).Value), " ")
    currLen = 0
    currRow = 0
    For i = 0 To UBound(arrWords) 'по всем словам
      If currLen + Len(arrWords(i)) + 1 > 45 Then 'не умещается
        currRow = currRow + 1
        If currRow > 2 Then Exit Sub 'лимит в 3 строки исчерпан
        currLen = 0
        For j = 1 To Len(arrWords(i)) 'по всем буквам слова
          Cells(currRow * 2 + 15, currLen * 2 + 2).Value = Mid(arrWords(i), j, 1)
          currLen = currLen + 1
        Next j
      Else 'умещается
        For j = 1 To Len(arrWords(i)) 'по всем буквам слова
          Cells(currRow * 2 + 15, currLen * 2 + 2).Value = Mid(arrWords(i), j, 1)
          currLen = currLen + 1
        Next j
      End If
      Cells(currRow * 2 + 15, currLen * 2 + 2).Value = ""
      currLen = currLen + 1 'ставим "пробел"
    Next i
End If
End If
End Sub
Как это работатет:
1) щелкаете (или с клавы переходите) на ячейку В15
2) вводите в эту ячейку весь текст (например: "Посадил дед репку, выросла репка большая прибольшая. Стал он ее тянуть")
3)переходите на любую другую ячейку (можно просто Enter нажать)
Вуаля!

Так можно по каждой сделать и будет красиво как мне видится...

Добавлено через 9 минут
Кстати можно сделать чтоб при нажатии на энтер происходил автоматический переход на следующее поле для заполнение а не тупо вниз.
0
EducatedFool
0 / 0 / 0
Регистрация: 28.09.2009
Сообщений: 88
02.10.2009, 02:10 #10
Лучший ответ Сообщение было отмечено как решение

Решение

Сталкивался ранее с подобной задачей

В этот раз всё оказалось намного сложнее - пришлось помучиться с алгоритмом.

Но, тем не менее, теперь всё работает:

[IMG]http://s53.***********/i142/0910/6d/c420dd2a934c.jpg[/IMG]

Достаточно дважды щёлкнуть в любом из квадратиков, как Excel сам определит границы поля (и подсветит поле зелёным цветом), после чего предложит ввести / изменить текст в выбранном поле.

Пример файла с макросом:

[ссылка удалена]

Добавлено через 1 минуту
Вот весь код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Function ЯчейкаСРамкой(ByRef cell As Range) As Boolean
    ЯчейкаСРамкой = cell.Borders(xlEdgeTop).LineStyle <> xlNone And cell.Borders(xlEdgeBottom).LineStyle <> xlNone _
                    And cell.Borders(xlEdgeRight).LineStyle <> xlNone And cell.Borders(xlEdgeLeft).LineStyle <> xlNone
End Function
 
Sub ВводТекста()
    On Error Resume Next: Dim ra As Range
    ActiveSheet.UsedRange.Interior.ColorIndex = 0
    Set ra = ДиапазонДляВвода(ActiveCell)
    ra.Interior.Color = vbGreen
    defTXT = ТекстДиапазона(ra)
    txt = InputBox("Введите текст для выбранного поля", "Заполнение полей", defTXT)
    If txt <> defTXT Then ВводТекстаВДиапазон ra, txt
    ra.Interior.ColorIndex = 0
End Sub
 
Function ТекстДиапазона(ByVal ra As Range) As String
    For Each cell In ra.Cells
        ТекстДиапазона = ТекстДиапазона & IIf(Len(cell.Text), cell.Text, " ")
    Next cell
    ТекстДиапазона = RTrim(ТекстДиапазона)
End Function
 
Sub ВводТекстаВДиапазон(ByVal ra As Range, ByVal txt As String)
    If ra.Cells.Count < Len(txt) Then MsgBox "Текст не влезет", vbCritical, "Введите текст покороче": Exit Sub
    ra.ClearContents: Dim cell As Range: i = 1
    Application.ScreenUpdating = False
    For Each cell In ra.Cells
        cell = Mid(txt, i, 1): i = i + 1
    Next cell
    Application.ScreenUpdating = True
End Sub
 
 
Function ДиапазонДляВвода(ByRef cell As Range) As Range
    If Not ЯчейкаСРамкой(cell) Then Exit Function
    On Error Resume Next
    Dim cell1 As Range, cell2 As Range, rcell As Range: Set cell1 = cell: Set cell2 = cell
 
    While СверхуЕстьСтрока(cell1)
        Set cell1 = cell1(-1, 1)
    Wend
    Set cell1 = ПерваяЯчейкаСтроки(cell1)
 
    While СнизуЕстьСтрока(cell2)
        Set cell2 = cell2(3, 1)
    Wend
    Set cell2 = ПоследняяЯчейкаСтроки(cell2)
 
    For Each rcell In Range(cell1, cell2).Cells
        If ЯчейкаСРамкой(rcell) Then
            If ДиапазонДляВвода Is Nothing Then
                Set ДиапазонДляВвода = rcell
            Else
                Set ДиапазонДляВвода = Union(ДиапазонДляВвода, rcell)
            End If
        End If
    Next rcell
End Function
 
Function ПерваяЯчейкаСтроки(ByVal cell As Range) As Range
    Do While cell.Column > 2
        If ЯчейкаСРамкой(cell) Then Set cell = cell(1, -1) Else Set cell = cell(1, 3): Exit Do
    Loop
    Set ПерваяЯчейкаСтроки = cell
End Function
 
Function ПоследняяЯчейкаСтроки(ByRef cell As Range) As Range
    Do While cell.Column <= cell.SpecialCells(xlCellTypeLastCell).Column
        If ЯчейкаСРамкой(cell) Then Set cell = cell(1, 3) Else Set cell = cell(1, -1): Exit Do
    Loop
    Set ПоследняяЯчейкаСтроки = cell
End Function
 
Function СверхуЕстьСтрока(ByVal cell As Range) As Boolean
    Set cell = ПерваяЯчейкаСтроки(cell)
    If ЯчейкаСРамкой(cell(-1, 1)) And ЯчейкаСРамкой(cell(-1, 3)) Then
        If cell.Column = 2 Then
            СверхуЕстьСтрока = True
        Else
            If Not ЯчейкаСРамкой(cell(-1, -1)) Then СверхуЕстьСтрока = True
        End If
    End If
    If СверхуЕстьСтрока Then    ' слева
        Set cell = ПоследняяЯчейкаСтроки(cell)
 
        If ЯчейкаСРамкой(cell(-1, 1)) And Not ЯчейкаСРамкой(cell(-1, 3)) Then
            If cell.Column = 2 Then СверхуЕстьСтрока = False: Exit Function
            If ЯчейкаСРамкой(cell(-1, -1)) Then СверхуЕстьСтрока = True: Exit Function
        End If
    End If
    СверхуЕстьСтрока = False
End Function
 
Function СнизуЕстьСтрока(ByRef cell As Range) As Boolean
    Set cell = ПоследняяЯчейкаСтроки(cell)
    If ЯчейкаСРамкой(cell(3, 1)) And Not ЯчейкаСРамкой(cell(3, 3)) Then
        If cell.Column = 2 Then
            СнизуЕстьСтрока = False
        Else
            If ЯчейкаСРамкой(cell(3, -1)) Then СнизуЕстьСтрока = True
        End If
    End If
    If СнизуЕстьСтрока Then    ' слева
        Set cell = ПерваяЯчейкаСтроки(cell)
 
        If ЯчейкаСРамкой(cell(3, 1)) And ЯчейкаСРамкой(cell(3, 3)) Then
            If cell.Column = 2 Then СнизуЕстьСтрока = True: Exit Function
            If Not ЯчейкаСРамкой(cell(3, -1)) Then СнизуЕстьСтрока = True: Exit Function
        End If
    End If
    СнизуЕстьСтрока = False
End Function
Возможно, где-то в алгоритме и допущена ошибка, но в данном файле границы полей распознаются вроде бы правильно.
0
EducatedFool
0 / 0 / 0
Регистрация: 28.09.2009
Сообщений: 88
02.10.2009, 13:57 #11
Пример файла с макросом (см. предыдущее сообщение)
0
Вложения
Тип файла: rar qqq.rar (29.0 Кб, 101 просмотров)
yaser
133 / 78 / 6
Регистрация: 06.04.2009
Сообщений: 192
02.10.2009, 14:16 #12
Цитата Сообщение от R315K Посмотреть сообщение
А как ты через CommandButton напишешь неподготовленный текст тут же полюбому должно использоваться TextBox...или я тут уже что то путаю?...и как соеденить кноку с выводом в ячейки?Но идея мне нравиться)
В форме имеется тот-же TextBox и кнопка CommandButtton1 (например, - Заполнить). После заполнения TextBox-а, при нажатии CommandButtton1 (событие CommandButtton1.Click()), текст вносится в нужные ячейки, как уже довольно подробно расписали остальные участники обсуждения темы.
0
R315K
6 / 6 / 0
Регистрация: 04.06.2008
Сообщений: 29
04.10.2009, 14:33  [ТС] #13
Всем спасиб)...очень помогли ваши идеи...)
0
04.10.2009, 14:33
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
04.10.2009, 14:33

Ввод и поиск данных через форму, с выпадающем списком
В интернете нашел два Excel файла подходящие для моих задач но объединить в...

Парсер дерева в excel с выводом в форму на другом листе
Здравствуйте, друзья. В программировании у меня навыки стремятся к нулю, но...

Сохранение данных в запрос через форму по штрих коду, VBA
Добрый день. Подскажите, как с помощью VBA прописать, когда сканируешь штрих...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
13
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru