VBA: График работы c Пн-Вс из данных бд в строку

@carry-y · Регистрация: 19.05.2013

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

Возникла необходимость перевести данные из бд:
столбцы
Пн1, Пн2
Вт1, Вт2
Ср1, Ср2
Чт1, Чт2
Пт1, Пт2
Сб1, Сб2
Вс1, Вс2

Пример данных:

Пн 8:00 - 20:00
Вт 8:00 - 20:00
Ср 8:00 - 19:30
Чт 8:00 - 20:00
Пт 8:00 - 20:00
Сб 9:00 - 19:00
Вс 9:00 - 18:00

Перевести в строку:
из нашего примера будет иметь вид
Пн,Вт,Чт,Пт 8:00 - 20:00;Ср 8:00 - 19:30; Сб 9:00 - 19:00; Вс 9:00 - 18:00;

Подскажите может у кого есть готовые решения данной задачи? У кого какие идеи.

mobile · 11.01.2014, 20:06

Если понять почему в Пн,Вт,Чт нет периодов времени в строке, а в Пт, Ср, Сб и Вс есть, то слепить строку особого труда не составит.

@carry-y · 11.01.2014, 21:54 **[ТС]**

почему нету периодов...
периоды есть Пн,Вт,Чт,Пт 8:00 - 20:00;
Это относится к Пн,Вт,Чт,Пт и для них строка одна, т.к. период у них совпадает с 8:00 - 20:00
Но мне подсказали еще вариант другой (спасибо nord-woolf), можно посмотреть во вложении
может кому пригодится

mobile · 11.01.2014, 23:11

Ну, мы тоже че-то можем.

@minob · 12.01.2014, 02:00

Без наворотов.
Использована база, выложенная неким

vip-y на другом форуме.

@carry-y · 12.01.2014, 02:30 **[ТС]**

это мой ник на другом форуме

@carry-y · 13.01.2014, 13:22 **[ТС]**

код, который предложил minob мне как раз подходит, мне не нужно ничего менять в базе
хороший код, спасибо
подскажите, мне нужно если с 9.00 по 19.30, то должно быть 9 - 19.13 (т.е. если в минутах стоят нули их убрать)
т.к. я на VBA особо не пишу, прошу помощи:
вот код:

Visual Basic

Function Fweek$()
  Dim dw, lw(0 To 6) As Boolean, i&, j&, sd$, st$
  dw = Array("Пн", "Вт", "Ср", "Чт", "Пт", "Сб", "Вс")
  For i = 0 To 6
    If Not lw(i) Then
      sd = sd & dw(i)
      st = Format(Me(dw(i)), "h:nn") & " - " & Format(Me(dw(i) & "1"), "h:nn")
      For j = i + 1 To 6
        If st = Format(Me(dw(j)), "h:nn") & " - " & Format(Me(dw(j) & "1"), "h:nn") Then
          sd = sd & "," & dw(j)
          lw(j) = True
        End If
      Next
      sd = sd & " " & st & "; "
    End If
  Next
  Fweek = sd
End Function

то, что приходит в голову
это что-то типо:
...

Visual Basic

If Format(Me(dw(i)), "nn") = 0 Then
      st = Format(Me(dw(i)), "h")
      If Format(Me(dw(i) & "1"), "nn") = 0 Then
      st = Format(Me(dw(i) & "1"), "h")

...
но я предполагаю есть способ лучше
можно ли сразу проверить в

Visual Basic

1	Format(Me(dw(i)), "h:nn") & " - " & Format(Me(dw(i) & "1"), "h:nn")?

@minob · 13.01.2014, 13:44

Сообщение от carry-y

можно ли сразу проверить в

Visual Basic

1	Format(Me(dw(i)), "h:nn") & " - " & Format(Me(dw(i) & "1"), "h:nn")?

Пробуйте

Visual Basic

1	Replace(Format(Me(dw(i)), "h:nn") & " - " & Format(Me(dw(i) & "1"), "h:nn"), ":00", "")

Не забудьте изменить и в проверке
If st = ...

@carry-y · 13.01.2014, 15:30 **[ТС]**

все работает
Спасибо!

Добавлено через 48 минут
ну и для полного счастья
есть ли в vba возможность выделить часть теста другим цветом?
есть примеры как выделить форму, поля, но как часть текста выделить не нашел

Добавлено через 29 секунд
в частности нужно сб, вс выделить красным цветом

@minob · 13.01.2014, 17:11

Сообщение от carry-y

в частности нужно сб, вс выделить красным цветом

В текстбоксе выделить часть текста цветом нельзя.
Это можно сделать в ActiveX RichTextBox.

@carry-y · 13.01.2014, 18:19 **[ТС]**

я извиняюсь, но выскакивает ошибка "Невозможно найти проект или библиотеку"

Добавлено через 27 минут
скорее всего у меня отсутствует какая-то библиотека
пишет при запуске базы:
richttx32.ocx отсутствует или не правильная ссылка

Добавлено через 12 минут
win server 2008
access 2003
скачал richttx32.ocx и зарегистрировал в системе - ошибка не исчезла

Добавлено через 12 минут
При загрузке пишет: Объект отсутствует в текущем элементе управления
Потом: Run-time error 438
Объект не поддерживает такой метод или свойство

@minob · 13.01.2014, 18:27

В Access в References подключите Microsoft Rich Textbox Control 6.0 (SP6)
На всякий случай выкладываю свой richtx32.ocx

@carry-y · 13.01.2014, 18:34 **[ТС]**

Все отлично заработало.
Благодарю.

@carry-y · 24.01.2014, 19:44 **[ТС]**

возникла еще одна проблемка у меня.... (с кодом все отлично

)
не могу обновить данные
есть форма и на ней две подчиненные формы
как только в подчиненной форме результата для вывода нету (т.е. ничего не выводит), ну и естественно во второй подчиненной форме так же не будет ничего
у меня на первой подчиненной форме стоит перехват клавиш и форма обновляется уже с другими данными
так вот, после такого обновления по горячей кнопки - функция преобразования даты не обновляется (это именно тогда происходит, когда у нас нулевой результат в начале !!!!!)
когда перехожу в режим конструкто и обратно - все норм
сижу реально пол дня и не могу понять в чем проблема

P.S. у меня стоит requery подчиненных форм все правильно! пробывал и основную и repaint,refresh. Перепробывал все((( что мог....
Если кто решится помощь скину базу

@carry-y · 27.01.2014, 14:27 **[ТС]**

проблема решилась банально
On Error Resume Next

Добавлено через 2 минуты
а было все из-за того, что if ссылался на несуществующие контролы, т.к. данные при некоторых запросах могут не существовать

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
		1
	VBA: График работы c Пн-Вс из данных бд в строку 11.01.2014, 18:21. Показов 1921. Ответов 14 Метки нет (Все метки) Возникла необходимость перевести данные из бд: столбцы Пн1, Пн2 Вт1, Вт2 Ср1, Ср2 Чт1, Чт2 Пт1, Пт2 Сб1, Сб2 Вс1, Вс2 Пример данных: Пн 8:00 - 20:00 Вт 8:00 - 20:00 Ср 8:00 - 19:30 Чт 8:00 - 20:00 Пт 8:00 - 20:00 Сб 9:00 - 19:00 Вс 9:00 - 18:00 Перевести в строку: из нашего примера будет иметь вид Пн,Вт,Чт,Пт 8:00 - 20:00;Ср 8:00 - 19:30; Сб 9:00 - 19:00; Вс 9:00 - 18:00; Подскажите может у кого есть готовые решения данной задачи? У кого какие идеи. 0

mobile 26806 / 14485 / 3192 Регистрация: 28.04.2012 Сообщений: 15,782
	11.01.2014, 20:06	2
	Если понять почему в Пн,Вт,Чт нет периодов времени в строке, а в Пт, Ср, Сб и Вс есть, то слепить строку особого труда не составит. 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	12.01.2014, 02:30 [ТС]	6
	это мой ник на другом форуме 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	13.01.2014, 15:30 [ТС]	9
	все работает Спасибо! Добавлено через 48 минут ну и для полного счастья есть ли в vba возможность выделить часть теста другим цветом? есть примеры как выделить форму, поля, но как часть текста выделить не нашел Добавлено через 29 секунд в частности нужно сб, вс выделить красным цветом 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	13.01.2014, 18:19 [ТС]	11
	я извиняюсь, но выскакивает ошибка "Невозможно найти проект или библиотеку" Добавлено через 27 минут скорее всего у меня отсутствует какая-то библиотека пишет при запуске базы: richttx32.ocx отсутствует или не правильная ссылка Добавлено через 12 минут win server 2008 access 2003 скачал richttx32.ocx и зарегистрировал в системе - ошибка не исчезла Добавлено через 12 минут При загрузке пишет: Объект отсутствует в текущем элементе управления Потом: Run-time error 438 Объект не поддерживает такой метод или свойство 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	13.01.2014, 18:34 [ТС]	13
	Все отлично заработало. Благодарю. 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	24.01.2014, 19:44 [ТС]	14
	возникла еще одна проблемка у меня.... (с кодом все отлично) не могу обновить данные есть форма и на ней две подчиненные формы как только в подчиненной форме результата для вывода нету (т.е. ничего не выводит), ну и естественно во второй подчиненной форме так же не будет ничего у меня на первой подчиненной форме стоит перехват клавиш и форма обновляется уже с другими данными так вот, после такого обновления по горячей кнопки - функция преобразования даты не обновляется (это именно тогда происходит, когда у нас нулевой результат в начале !!!!!) когда перехожу в режим конструкто и обратно - все норм сижу реально пол дня и не могу понять в чем проблема P.S. у меня стоит requery подчиненных форм все правильно! пробывал и основную и repaint,refresh. Перепробывал все((( что мог.... Если кто решится помощь скину базу 0

@carry-y 77 / 21 / 3 Регистрация: 19.05.2013 Сообщений: 221
	27.01.2014, 14:27 [ТС]	15
	проблема решилась банально On Error Resume Next Добавлено через 2 минуты а было все из-за того, что if ссылался на несуществующие контролы, т.к. данные при некоторых запросах могут не существовать 0