Форум программистов, компьютерный форум, киберфорум
Наши страницы

VBA

Войти
Регистрация
Восстановить пароль
 
Рейтинг: Рейтинг темы: голосов - 31, средняя оценка - 4.84
R315K
6 / 6 / 1
Регистрация: 04.06.2008
Сообщений: 29
#1

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

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

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

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

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

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

Программное заполнение списка на листе Excel - VBA
Есть список (элемент формы) на листе Excel. Имя списка отображается на листе как "Окно списка 3", в макросах - как "Окносписка3". Можно ли...

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

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

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

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

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

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

Хм...интересно)
А как ты через CommandButton напишешь неподготовленный текст тут же полюбому должно использоваться TextBox...или я тут уже что то путаю?...и как соеденить кноку с выводом в ячейки?Но идея мне нравиться)
0
Toxa33rus
3813 / 877 / 87
Регистрация: 16.04.2009
Сообщений: 1,758
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
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
Возможно, где-то в алгоритме и допущена ошибка, но в данном файле границы полей распознаются вроде бы правильно.
EducatedFool
02.10.2009, 13:57 #11
Пример файла с макросом (см. предыдущее сообщение)
Вложения
Тип файла: rar qqq.rar (29.0 Кб, 99 просмотров)
yaser
132 / 77 / 6
Регистрация: 06.04.2009
Сообщений: 192
02.10.2009, 14:16 #12
Цитата Сообщение от R315K Посмотреть сообщение
А как ты через CommandButton напишешь неподготовленный текст тут же полюбому должно использоваться TextBox...или я тут уже что то путаю?...и как соеденить кноку с выводом в ячейки?Но идея мне нравиться)
В форме имеется тот-же TextBox и кнопка CommandButtton1 (например, - Заполнить). После заполнения TextBox-а, при нажатии CommandButtton1 (событие CommandButtton1.Click()), текст вносится в нужные ячейки, как уже довольно подробно расписали остальные участники обсуждения темы.
0
R315K
6 / 6 / 1
Регистрация: 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 с выводом в форму на другом листе - VBA
Здравствуйте, друзья. В программировании у меня навыки стремятся к нулю, но очень хочется освоить. Сейчас пытаюсь...

Поиск и ввод данных в таблицу Excel через форму VBA - VBA
Добрый день! По работе столкнулась с необходимостью заполнять большие таблицы, в которых сложно найти нужную строку. Решила сделать...

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

Запись данных через форму при выборе листа в списке - VBA
Здравствуйте! Подскажите пожалуйста как сделать что бы запись данных через форму записывалась на лист выбранный в списке на форме.


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

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

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