Несколько событий, происходящих в одну и ту же дату

@yurimo100 · Регистрация: 09.02.2014

Студворк — интернет-сервис помощи студентам

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
Private Sub Form_Activate()
 
Label2 = Date
 Dim Conn As New ADODB.Connection, RS As New ADODB.Recordset
Conn.Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\User\Downloads\VB примеры\Nap4\Event_db.accdb;Persist Security Info=False;"
RS.Open "SELECT Da_te, Event, Ti_me, Doctor, Phone, Location, Da_te2 FROM Event_tbl WHERE Da_te =#" + Format$(Date, "mm\/dd\/yyyy") + "#", Conn
If Not RS.EOF Then
 
  
  Label6 = RS("Da_te")
  Label7 = RS("Ti_me")
  Label8 = RS("Doctor")
  Label9 = RS("Phone")
  Label10 = RS("Location")
  Label5 = RS("Event")
   'Label61 = RS("Da_te")
  'Label71 = RS("Ti_me")
  'Label81 = RS("Doctor")
  'Label91 = RS("Phone")
  'Label101 = RS("Location")
  'Label51 = RS("Event")
Else
  Label5 = "Нет событий"
  
End If
RS.Close
Conn.Close
 
End Sub

Этот код позволяет мне при достижении сегодняшней даты выводить в Labels из БД записи, соответствующие этой дате, т.е. событие наступает при достижении сегодняшней даты.
Но таких событий, с сегодняшней датой, может быть несколько в БД (1 или 2 или 3).
Как сделать, чтобы при достижении сегодняшней даты, если есть несколько записей, выводить их в разные Labels, в соответствии с событием?
Например: Сегодня есть очередь к врачу - все записи выводятся в Labels связанные с этим событием, но сегодня есть очередь и к другому врачу - все записи должны выводиться в другие Labels связанные уже с этим событием и т.д.

@Alex77755 · 29.11.2014, 20:58

Как бы Вы решили эту проблему

Я выложил вариант решения

@yurimo100 · 29.11.2014, 22:21 **[ТС]**

Alex77755,
Я сделал программу по другому, добавил в БД еще несколько полей и вывод каждого события в один лабел, а также
добавил еще запрос. Учитывая, что событий происходящих в одну дату будет максимум три, лабелс будет три, а полей в БД будет 6*3=18. Конечно это не так красиво, но полностью соответствует моей задаче.
Если Вас интересует, я пришлю код.

Сообщение от Alex77755

Я выложил вариант решения

Если Вы имеете в виду этот код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
RS.MoveLast ' две строчки для подсчёта количества записей в таблице
RS.MoveFirst '
For J = 1 To RS.RecordCount ' с начала до конца таблицы
''' эти строки замени если хочешь выводить в лабелы----------------------------------------
.Rows = .Rows + 1 ' прибавить строчку в таблице
    For c = 0 To .Cols - 1
        .TextMatrix(J, c) = RS.Fields(c) ' заполнить значениями
    Next c
""""""---------------------------------------------------------------------
RS.MoveNext ' следующая строка в таблице базы
Next J 'следующая строка

я не знаю куда его вставить и как его подогнать под мою задачу.
Большое спасибо за помощь и извините, если разозлил Вас своими вопросами.

@Alex77755 · 29.11.2014, 23:13

Я имею в виду Nap5.rar всообщении № 17

Добавлено через 1 минуту

Учитывая, что событий происходящих в одну дату будет максимум три,

Повторяю: Это тупое решение!

Добавлено через 7 минут

Если Вас интересует, я пришлю код.

Что бы я без тебя делал!
Я уже и так сохранил образец базы как не надо делать!

@yurimo100 · 30.11.2014, 00:09 **[ТС]**

Alex77755,
Да, это самое то. Большое спасибо.
Nap5.rar я как то пропустил.
Не могли бы вы прокомментировать назначение строк кода.
Я не программист и все делаю для собственного использования ну и изучаю попутно VB6.

@Alex77755 · 30.11.2014, 10:53

Ну как-то так

Кликните здесь для просмотра всего текста

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
Private Sub Form_Activate() 'при активации формы
    'объявление переменных
    Dim conn As New ADODB.Connection '
    Dim rs As New ADODB.Recordset '
    Dim PAT '
    '    Set conn = Nothing ' если conn не объявленна глобально эта строка не нужна
         PAT = App.Path & "\Event_db.accdb" ' установка пути к базе рядом с программой
        Set conn = New ADODB.Connection ' назначение нового соединения
        conn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=" & PAT & ";Uid=Admin;Pwd=;" 'назначение параметров соединения
        conn.Open ' открытие соединения
        
        Set rs = New ADODB.Recordset ' назначение набора записей
        SQL = "SELECT * FROM Event_tbl  WHERE [Event_tbl.Da_te] =#11-29-2014#;" 'назначение строки запроса с форматированием сегодняшней даты
         rs.Open SQL, conn, 3, 3 ' открытие набора записей
    
    Label2 = Date ' назначить метке текущую дату
    
    If Not rs.EOF Then ' если есть записи в наборе
            Список = "" ' очистить список
            
    'эти две строчки нужны для нормальной работы с набором записей
    'без них не стабильно определяется количество записей в наборе RecordCount
            rs.MoveLast ' перейти на последнюю запись
            rs.MoveFirst 'перейти на первую запись
            
            For i = 0 To rs.RecordCount - 1 ' по всем записям в наборе
                S = "" ' очищаем сборную строку
                    S = rs("Doctor") & "  " & rs("Da_te") & "  " & rs("Ti_me") & "  " & rs("Location") & "  " & rs("Phone") ' собираем сборную строку из полей набора записей
                    Список = Список & vbCrLf & S ' дописываем в список строку
            rs.MoveNext ' переходим на следующую запись в наборе
            Next i 'следующая строка
    Else ' иначе. Если нет записей удовлетворяющих запросу
      Label5 = "Нет событий" '
    End If '
    rs.Close ' закрыть набор
    conn.Close 'закрыть соединение
End Sub

@yurimo100 · 30.11.2014, 16:43 **[ТС]**

Alex77755,
Огромное спасибо!!!!

Добавлено через 4 часа 43 минуты
Подскажите, пожалуйста, как вместо вывода в Labels вывести в Grid.

@Alex77755 · 30.11.2014, 18:28

Из моей программы. Разбирайся

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Комманда1_Click() ' Всё. показать весь список
Dim c
With FG ' выбрать таблицу
.Rows = 1 ' назначить в таблице одну строку
 
RS.MoveLast ' две строчки для подсчёта количества записей в таблице
RS.MoveFirst '
.TextMatrix(0, 0) = RS.Fields(0).Name ' заполнить значениями
    For c = 0 To .Cols - 1
      .TextMatrix(0, c) = RS.Fields(c).Name
     Next c
 
For J = 1 To RS.RecordCount ' с начала до конца таблицы
    .Rows = .Rows + 1 ' прибавить строчку в таблице
    For c = 0 To .Cols - 1
        .TextMatrix(J, c) = RS.Fields(c) ' заполнить значениями
    Next c
RS.MoveNext ' следующая строка в таблице базы
Next J 'следующая строка
 
End With ' конец выбрать
End Sub 'конец процедуры

Добавлено через 3 минуты
Грид сначала надо отформатировать. Примерно так

Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Sub Form_Load()
 
SF.ColWidth(1) = 2000 ' назначение ширины колонок
With FG ' выбрать таблицу
.ColWidth(0) = 6000 ' назначение ширины колонок
.ColWidth(1) = 800 '
.ColWidth(2) = 2500 ' назначение ширины колонок
.ColWidth(3) = 1200 '
.ColWidth(4) = 1200 '
End With ' конец выбрать

В примере выше набор записей у меня глобалный и получен в другой процедуре
Согласуй всё сам

@yurimo100 · 30.11.2014, 20:14 **[ТС]**

Alex77755,
Спасибо, сижу разбираюсь.

Новые блоги и статьи Все статьи Все блоги /
Копировать Windows на новый диск на UEFI damix 17.10.2026 https:/ / uriesk. wordpress. com/ 2016/ 11/ 01/ move-window-10-to-ssd-on-a-uefi-dualboot-system-with-basic-linux-tools/ TL DR Вставляем диск, а старый подключаем через переходник, грузимся с лайва. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@yurimo100 8 / 8 / 2 Регистрация: 09.02.2014 Сообщений: 124
	30.11.2014, 00:09 [ТС]
	Alex77755, Да, это самое то. Большое спасибо. Nap5.rar я как то пропустил. Не могли бы вы прокомментировать назначение строк кода. Я не программист и все делаю для собственного использования ну и изучаю попутно VB6. 0

@yurimo100 8 / 8 / 2 Регистрация: 09.02.2014 Сообщений: 124
	30.11.2014, 16:43 [ТС]
	Alex77755, Огромное спасибо!!!! Добавлено через 4 часа 43 минуты Подскажите, пожалуйста, как вместо вывода в Labels вывести в Grid. 0

@yurimo100 8 / 8 / 2 Регистрация: 09.02.2014 Сообщений: 124
	30.11.2014, 20:14 [ТС]
	Alex77755, Спасибо, сижу разбираюсь. 0

Несколько событий, происходящих в одну и ту же дату

Решение