Автоматизация работы кинотеатра в Excel на Visual Basic

@Minami · Регистрация: 29.02.2016

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

Дали задание, автоматизировать работу кинотеатра, самую малость сделала, но так как с Excel и VB почти не знакома не имею представления с помощью чего, и как сделать так, чтобы при нажатии на любое место в схеме кинотеатра отображалось сразу в билете место, ряд и цена. Сказали сделать либо с помощью макроса либо с помощью VB. Еще не знаю как сделать места красным цветом, чтобы потом все так же работало и как быть с общей суммой забронированных и купленных билетов.Еще сказали подумать над тем чтобы схема зала каждый раз обновлялась для каждого фильма, до сих пор нет идей. Надо сделать красивый билет еще, честно не думала что это может быть сложно. Если будут какие то идеи для билета вдруг, буду благодарна если кто нибудь поможет

Само задание
Небольшой кинотеатр «Люмьер», имеющий только один зрительный зал,
осуществляет бронирование билетов на просмотр фильмов. В расписании сеансов
кинотеатра одновременно присутствует не менее 4, но и не более, чем 10 наименований
фильмов, для каждого из которых запланировано не более 5, но и не менее 3 сеансов.
Необходимо сформировать в MS Excel таблицу, отражающую распределение
купленных и забронированных билетов Таблица должна содержать схематичное
изображение зрительного зала из не менее, чем 12 рядов по 15 кресел в каждом.
Стоимость билетов варьируется в зависимости от ряда, в котором находится кресло.
Стоимости билетов фиксированные, от 200 до 800 руб. с шагом 50 руб. Стоимость билета
для каждого ряда задается выбором из заранее сформированного списка. Для нескольких
рядов стоимость может быть одинаковой.
«Статус» места в зрительном зале может быть: «свободно» - значение 0,
«забронировано» - значение 1, «продано» - значение 2. При изменении статуса цвет ячейки
и значения, хранящегося в ней, должен измениться на «свободно» - «зеленый»,
«забронировано» - «желтый», «продано» - «синий». В остальных случаях цвет ячейки
должен быть красным.
Под схемой зала необходимо разместить информацию о том, какой фильм и какой
сеанс отображены на схеме. Название фильма и время сеанса должны храниться в
отдельной таблице. Их выбор должен осуществляться в формальном виде, например, при
помощи выпадающего списка. Данную таблицу целесообразно разместить в отдельном
файле, так как эта же таблица с названиями и временем сеанса фильма должна
использоваться, как источник данных для формирования афиш формата А3 методом
«слияния» документов. На основе данного шаблона необходимо получить афиши для всех
фильмов из списка.
Также под схемой зрительного зала следует разместить информацию о количестве
свободных мест, количестве забронированных мест и общей сумме за забронированные
билеты, количестве проданных билетов и общей сумме за проданные билеты.
Под информацией о количестве и стоимости билетов необходимо разместить
шаблон билета. Он должен содержать название фильма и сеанс, номере места и номере
ряда, стоимости билета. Билет должен быть размещен на фиолетовом фоне. При печати
листа книги должен быть распечатан только один билет.
На отдельном листе необходимо сформировать диаграмму, которая отражает
распределение выкупленных и забронированных билетов в зависимости от номера ряда.
Диаграмма также должна содержать информацию о названии фильма и сеансе просмотра.
- таблицу с расчетами,
- таблицу с перечнем фильмов,
- шаблон афиши,
- готовые афиши (все – в одном файле).

@CRIDEL · 24.02.2018, 23:15

для начала:

https://support.office.com/ru-... d913033d18

https://support.microsoft.com/... n-excel-or

а дальше думай, за тебя никто писать не будет.

SoftIce · 25.02.2018, 07:29

Что-то было, только про театр

@Estimable · 27.02.2018, 08:50

1) по билету: надо чтобы картинка из фильма накладывалась на надписи: место, ряд, цена. т.к невозможно написать под картинкой то сделать два пути:заполняется автоматически и из других ячеек вручную.

2)Чтобы менялся цвет квадратиков при выборе из списка 1,2,0 сделайте проверку значений этих ячеек на изменении значений листа "Кинотеатр" в макросах.
3)чтобы в билет вносились значения: место, ряд, цена. Надо проверять значение активной ячейки на изменении значений листа "Кинотеатр" в макросах.
4)Чтобы менялась картинка на билете создайте лист картинок предстоящих фильмов, и пусть макросы автоматически меняют картинки билетов меняя адресацию к этим картинкам.

Добавлено через 1 минуту
Это не сложно, просто - долго. А на словах могу обьяснить.

@Minami · 01.03.2018, 05:00 **[ТС]**

Если объяснить не составит сложности, буду очень благодарна. Я поменяла цвет квадратиков, но при помощи условного форматирования, а вот с красным цветом проблема, там нет условий как с предыдущими цветами. Не знаю, как с этим быть, либо просто сначала закрасить красным цветом, а менять с помощью макроса цвета

@Estimable · 03.03.2018, 11:01

Вот немного усовершенствовал твой документ.
1)При нажатии на любое место в зале на листе "кинотеатр" в билете появится: цена, ряд, место
2)При выборе фильма в ячейке j16 загрузится карта зала этого фильма с листа "Выкупленные билеты"
3)При изменении характеристики места(0,1,2) она копируется в карту зала именно этого фильма на листе "Выкупленные билеты"

Вот макросы: Два из них записаны на ИЗМЕНЕНИЕ ЯЧЕЙКИ в макросах листа "кинотеатр", а один на ВЫБОРЕ ЯЧЕЙКИ в макросах листа "Выкупленные билеты"

Вот их код:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
 
'если изменим какую либо ячейку на первом листе,то изменится в  этом фильме в выкупленных билетах
Dim x As Integer
Dim y As Integer
Dim Smesh_y As Integer
Dim rabota As String
 
x = ActiveCell.Column
y = ActiveCell.Row
 
 
If Target.Column < 3 Or Target.Column > 17 Then GoTo preex
If Target.Row < 3 Or Target.Row > 14 Then GoTo preex
 
 
rabota = Sheets("Кинотеатр").Range("j16") 'места для какого фильма
 
If rabota = "Тор" Then Smesh_y = 0: GoTo nach1
If rabota = "Халк" Then Smesh_y = 14: GoTo nach1
If rabota = "Мстители" Then Smesh_y = 28: GoTo nach1
If rabota = "Первый мститель" Then Smesh_y = 42: GoTo nach1
If rabota = "Валли" Then Smesh_y = 56: GoTo nach1
If rabota = "Русалочка" Then Smesh_y = 70: GoTo nach1
If rabota = "Амнезия" Then Smesh_y = 84: GoTo nach1
If rabota = "Эверест" Then Smesh_y = 98: GoTo nach1
If rabota = "Легенда о синем море" Then Smesh_y = 112: GoTo nach1
 
nach1:
Sheets("Выкупленные билеты").Cells(y + Smesh_y, x) = Sheets("Кинотеатр").Cells(y, x)
 
'------------------------------
preex: 'если изменим название фильма, то загрузить его из карты зала с выкупленных билетов
If Target.Column <> 10 Then GoTo exx
If Target.Row <> 16 Then GoTo exx
 
rabota = Sheets("Кинотеатр").Range("j16") 'места для какого фильма
 
If rabota = "Тор" Then Smesh_y = 0: GoTo nach
If rabota = "Халк" Then Smesh_y = 14: GoTo nach
If rabota = "Мстители" Then Smesh_y = 28: GoTo nach
If rabota = "Первый мститель" Then Smesh_y = 42: GoTo nach
If rabota = "Валли" Then Smesh_y = 56: GoTo nach
If rabota = "Русалочка" Then Smesh_y = 70: GoTo nach
If rabota = "Амнезия" Then Smesh_y = 84: GoTo nach
If rabota = "Эверест" Then Smesh_y = 98: GoTo nach
If rabota = "Легенда о синем море" Then Smesh_y = 112: GoTo nach
 
nach:
For x = 3 To 17
For y = 3 To 14
Sheets("Кинотеатр").Cells(y, x) = Sheets("Выкупленные билеты").Cells(y + Smesh_y, x)
Next y
Next x
 
exx:
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'при нажатии на любое место в зале - информация о нём появится в билете
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
 
'для нахождения цены для данного места
Dim x As Integer
Dim y As Integer
 
 
x = ActiveCell.Column
y = ActiveCell.Row
 
'proverk = Sheets("Цена").Cells(y, x)
Sheets("Кинотеатр").Range("K30") = x - 2
Sheets("Кинотеатр").Range("K31") = y - 2
Sheets("Кинотеатр").Range("K32") = Sheets("Цена").Cells(y, x)
 
 
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
 
 
 
 
End Sub

Прилагаю изменённый документ.
ps:Не забудь включить макросы при открытии этого документа

@Estimable · 03.03.2018, 11:03

Информация в билет попадает с листа Цена

@Minami · 03.03.2018, 19:10 **[ТС]**

Ого, большое спасибо! Честно, сама бы очень долго мучилась писать этот код. Пока мало что понимаю, но так думаю легче будет разобраться по коду, как и что работает. Только вот немного непонятно, почему такая нумерация в выборке фильма в макросе от 0 до 112, если сложно это объяснять, попытаюсь сама найти, очень помогли уже, спасибо)

@Minami · 06.03.2018, 10:39 **[ТС]**

Я только думала что при нажатии на диапазон мест, выбирать из них будет, не со всего поля. Такое вообще возможно сделать? А то там вроде указан диапазон схемы мест, но все же он и остальные показывает в билете места, если такое вообще можно сделать.

@Estimable · 07.03.2018, 05:49

Ну от 0 до 112 это добавляемое смещение по y. Это означает что тор начинается сразу сверху листа. Халк на 14 клеточек ниже от первого, мстители на 28 клеточек ниже от первого и т д, т.е каждый следующий на 14 клеточек ниже.

А вот эти строки служебные, они отключают перерасчёт формул, отображение изменения на статусбаре, отслеживание событий и обновление экрана для ускорения работы макроса.

Visual Basic
1
2
3
4
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False

вот эта строка: означает что макрос запускается когда произойдёт изменение значения какой-либо клеточки на этом листе

Visual Basic
1
Private Sub Worksheet_Change(ByVal Target As Range)

вот эта строка: означает что макрос запускается когда пользователь тыкнет курсором на ячейку

Visual Basic
1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

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

По поводу диаграмы или просто рисования в Экселе. Есть готовые диаграмы, которыми можно управлять с помощью макросов и есть второй способ - стянуть все клеточки на каком-либо листе до размера 1x1 пиксель. И адресовать цвет каждого пикселя процедуркой рисования фигур, например круга по алгоритму брезенхайма.

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

@Alex77755 · 08.03.2018, 20:06

Дали задание

хмм....
и как долго, думаешь, за тебя будет работать дядя?

@Minami · 09.03.2018, 07:33 **[ТС]**

Я имела ввиду диапазон мест в зале, когда на них нажимаешь, информация отображается в билете, а когда нажимаешь на любое другое поле, не попадающее в этот диапазон, он все равно выдает место и ряд в билет, только без цены.
Спасибо большое за объяснение и помощь

Добавлено через 18 минут
Alex77755, Извините конечно, но если мало времени чтобы постичь полностью vb, а писать как то надо, или думаете это уже готовая программа, которую не скажут переправлять или что то добавлять, то нет придется еще с ней мучится. А когда еще ни разу не работал в этой среде, это очень сложно кажется

@Estimable · 11.03.2018, 06:49

Minami, да я понял о чём ты - там диапазон зала нужно было ограничить переменной Target.

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

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ïðè íàæàòèè íà ëþáîå ìåñòî â çàëå - èíôîðìàöèÿ î í¸ì ïîÿâèòñÿ â áèëåòå
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
 
'äëÿ íàõîæäåíèÿ öåíû äëÿ äàííîãî ìåñòà
Dim x As Integer
Dim y As Integer
Dim line As String
Dim place As String
Dim price As String
 
 
x = ActiveCell.Column
y = ActiveCell.Row
 
line = " " 'åñëè ñíàðóæè äèàïàçîíà, òî áèëåò ïóñòîé
place = " "
price = " "
 
 
If Target.Column < 3 Or Target.Column > 17 Then GoTo preex1
If Target.Row < 3 Or Target.Row > 14 Then GoTo preex1
 
line = x - 2 'âíóòðè äèàïàçîíà çàëà áóäåò âû÷èñëÿòñÿ áèëåò)
place = y - 2
price = Sheets("Öåíà").Cells(y, x)
 
 
 
preex1:
 
'proverk = Sheets("Öåíà").Cells(y, x)
Sheets("Êèíîòåàòð").Range("K30") = line
Sheets("Êèíîòåàòð").Range("K31") = place
Sheets("Êèíîòåàòð").Range("K32") = price
 
 
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
 
 
 
 
End Sub

@Estimable · 11.03.2018, 06:51

Каракули - потому что unicode. Вот фаил.

@sergeos · 12.03.2018, 21:22

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

Каракули - потому что unicode. Вот фаил.

А чтобы не было каракулей надо копировать код с переключенной русской раскладкой. Попробуй.

@Estimable · 15.03.2018, 07:25

А вот тут каракули хорошо получились))

Assembler
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
                                        _..  
                                          .qd$$$$bp.
                                        .q$$$$$$$$$$m.
                                       .$$$$$$$$$$$$$$
                                     .q$$$$$$$$$$$$$$$$
                                    .$$$$$$$$$$$$P\$$$$;
                                  .q$$$$$$$$$P^"_.`;$$$$
                                 q$$$$$$$P;\   ,  /$$$$P
                               .$$$P^::Y$/`  _  .:.$$$/
                              .P.:..    \ `._.-:.. \$P
                              $':.  __.. :   :..    :'
                             /:_..::.   `. .:.    .'|
                           _::..          T:..   /  :
                        .::..             J:..  :  :
                     .::..          7:..   F:.. :  ;
                 _.::..             |:..   J:.. `./
            _..:::..               /J:..    F:.  : 
          .::::..                .T  \:..   J:.  /
         /:::...               .' `.  \:..   F_o'
        .:::...              .'     \  \:..  J ;
        ::::...           .-'`.    _.`._\:..  \'
        ':::...         .'  `._7.-'_.-  `\:.   \
         \:::...   _..-'__.._/_.--' ,:.   b:.   \._ 
          `::::..-"_.'-"_..--"      :..   /):.   `.\   
            `-:/"-7.--""            _::.-'P::..    \} 
 _....------""""""            _..--".-'   \::..     `. 
(::..              _...----"""  _.-'       `---:..    `-.
 \::..      _.-""""   `""""---""                `::...___)
  `\:._.-"""

Добавлено через 4 минуты
По поводу цвета ячеек - добавить красный цвет, нр на цифру 4, не получается. Так как все ячейки являются списками, надо переделывать весь документ.

Новые блоги и статьи Все статьи Все блоги /
Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Изучаю kubernetes lagorue 13.01.2026 А пригодятся-ли мне знания kubernetes в России?	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .
Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .	Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .

@CRIDEL 70 / 62 / 19 Регистрация: 03.05.2013 Сообщений: 397
	24.02.2018, 23:15
	для начала: https://support.office.com/ru-... d913033d18 https://support.microsoft.com/... n-excel-or а дальше думай, за тебя никто писать не будет. 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	25.02.2018, 07:29
	Что-то было, только про театр 0

@Estimable 195 / 14 / 1 Регистрация: 02.01.2017 Сообщений: 208
	27.02.2018, 08:50
	1) по билету: надо чтобы картинка из фильма накладывалась на надписи: место, ряд, цена. т.к невозможно написать под картинкой то сделать два пути:заполняется автоматически и из других ячеек вручную. 2)Чтобы менялся цвет квадратиков при выборе из списка 1,2,0 сделайте проверку значений этих ячеек на изменении значений листа "Кинотеатр" в макросах. 3)чтобы в билет вносились значения: место, ряд, цена. Надо проверять значение активной ячейки на изменении значений листа "Кинотеатр" в макросах. 4)Чтобы менялась картинка на билете создайте лист картинок предстоящих фильмов, и пусть макросы автоматически меняют картинки билетов меняя адресацию к этим картинкам. Добавлено через 1 минуту Это не сложно, просто - долго. А на словах могу обьяснить. 0

@Minami 1 / 1 / 0 Регистрация: 29.02.2016 Сообщений: 10
	01.03.2018, 05:00 [ТС]
	Если объяснить не составит сложности, буду очень благодарна. Я поменяла цвет квадратиков, но при помощи условного форматирования, а вот с красным цветом проблема, там нет условий как с предыдущими цветами. Не знаю, как с этим быть, либо просто сначала закрасить красным цветом, а менять с помощью макроса цвета 0

@Estimable 195 / 14 / 1 Регистрация: 02.01.2017 Сообщений: 208
	03.03.2018, 11:03
	Информация в билет попадает с листа Цена 0

@Minami 1 / 1 / 0 Регистрация: 29.02.2016 Сообщений: 10
	03.03.2018, 19:10 [ТС]
	Ого, большое спасибо! Честно, сама бы очень долго мучилась писать этот код. Пока мало что понимаю, но так думаю легче будет разобраться по коду, как и что работает. Только вот немного непонятно, почему такая нумерация в выборке фильма в макросе от 0 до 112, если сложно это объяснять, попытаюсь сама найти, очень помогли уже, спасибо) 0

@Minami 1 / 1 / 0 Регистрация: 29.02.2016 Сообщений: 10
	06.03.2018, 10:39 [ТС]
	Я только думала что при нажатии на диапазон мест, выбирать из них будет, не со всего поля. Такое вообще возможно сделать? А то там вроде указан диапазон схемы мест, но все же он и остальные показывает в билете места, если такое вообще можно сделать. 0

@Minami 1 / 1 / 0 Регистрация: 29.02.2016 Сообщений: 10
	09.03.2018, 07:33 [ТС]
	Я имела ввиду диапазон мест в зале, когда на них нажимаешь, информация отображается в билете, а когда нажимаешь на любое другое поле, не попадающее в этот диапазон, он все равно выдает место и ряд в билет, только без цены. Спасибо большое за объяснение и помощь Добавлено через 18 минут Alex77755, Извините конечно, но если мало времени чтобы постичь полностью vb, а писать как то надо, или думаете это уже готовая программа, которую не скажут переправлять или что то добавлять, то нет придется еще с ней мучится. А когда еще ни разу не работал в этой среде, это очень сложно кажется 0