Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
YTGoodFox
0 / 0 / 0
Регистрация: 30.04.2019
Сообщений: 20
1

Создание диаграммы

13.07.2019, 12:49. Просмотров 236. Ответов 5

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

Пожалуйста помогите выполнить задание.

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
Private Sub CommandButton4_Click()
' Активизируем рабочий лист с именем Диаграмма
Sheets("Диаграмма").Activate
'Очищаем лист от всех объектов
For Each I In ActiveSheet.Shapes
I.Delete
Next I
' Создаем новую диаграмму
ActiveSheet.ChartObjects.Add(25, 25, 500, 300).Select
With ActiveChart
' Задаем тип диаграммы (объемная гистограмма)
.ChartType = xl3DBarClustered
' Находим, сколько записей в таблице
m = 2
Do
If Sheets("База").Cells(m, 1).Value = "" Then Exit Do
m = m + 1
Loop
m = m - 1
' Определяем источник данных для построения диаграммы:
' с листа «База» от ячейки I2 до ячейки IM
.SetSourceData Source:=Sheets("База").Range("M2:M" + Trim(Str(m))), PlotBy:=xlRows
' Выбираем подписи к данным из первого столбца таблицы
For m = 2 To N
.SeriesCollection(N - 1).Name = "=База!R" + Trim(Str(m)) + "C1"
Next
'Размещение диаграммы на отдельном листе
.Location Where:=xlLocationAsObject, Name:="Диаграмма"
With ActiveChart
' Заголовок
.HasTitle = True
.ChartTitle.Characters.Text = "Сумма оплаты за воду (в рублях)"
'Легенда
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).Name = "=""Итоговая сумма"""
.HasDataTable = True
.Axes(xlCategory).MajorTickMark = xlNone
.Axes(xlCategory).MinorTickMark = xlNone
.Axes(xlCategory).TickLabelPosition = xlNone
End With
End With
End Sub
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
13.07.2019, 12:49
Ответы с готовыми решениями:

Создание диаграммы в Excel на форме
Привет! Хочу сделать в Excel программу, которая бы строила график квадратного уравнения. Что...

Добавление данных в таблицу и создание по ней диаграммы
Собственно, создаётся таблица и в неё добавляются данные (небольшая БД типо).У меня была таблица на...

Построение диаграммы. Создание нового тега и ошибка "type mismatch"
Здравствуйте! После запуска макроса выдает ошибку run-time error 13 type mismatch в этом месте...

Перемещение диаграммы
есть такой макрос создания диаграммы,как её переместить? потому что она создается не том месте что...

Легенда диаграммы
Здравствуйте, товарищи программисты! :) Помогите пожалуйста дополнить код, чтобы в легенде...

5
КулХацкеръ
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 87
14.07.2019, 14:59 2
Без образца данных для диаграммы говорить не о чем (в вашем файле их нет).
0
YTGoodFox
0 / 0 / 0
Регистрация: 30.04.2019
Сообщений: 20
14.07.2019, 16:15  [ТС] 3
Данные создадутся если на листе с именем меню вы нажмёте на "Приём платежа", там заполняется форма.
0
КулХацкеръ
29 / 15 / 12
Регистрация: 09.02.2018
Сообщений: 87
14.07.2019, 17:27 4
Походу переменные m и N в цикле стоят не на своих местах.

Сейчас:

Visual Basic
1
2
3
For m = 2 To N
     .SeriesCollection(N - 1).Name = "=База!R" + Trim(Str(m)) + "C1"
Next
Чтобы работало, надо так:

Visual Basic
1
2
3
For N = 2 To m
    .SeriesCollection(N - 1).Name = "=База!R" + Trim(Str(N)) + "C1"
Next
Это лишнее:
Visual Basic
1
ActiveChart.FullSeriesCollection(1).Name = "=""Итоговая сумма"""
0
YTGoodFox
0 / 0 / 0
Регистрация: 30.04.2019
Сообщений: 20
14.07.2019, 17:33  [ТС] 5
А можно сделать так что бы на диаграмме указывалось кому и чему соответствуют показатели. Если что это форма UseForm1, вот код всей формы(ну или вы сами можете посмотреть в файле):
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
Private Sub CommandButton1_Click()
'Декларация переменных
Dim fam, nam, adr As String
Dim tarif, prpok, tekpok, rashod, summa As Single
Dim nomer As Integer
Dim a As Variant
a = Date
'Вычисление номера первой свободной строки в таблице
nomer = Application.CountA(ActiveSheet.Columns(1)) + 1
With UserForm1
'Проверяем, введена ли фамилия
If .txtFamil.Text = "" Then
MsgBox "Вы забыли указать фамилию", vbExclamation
Exit Sub 'Выход из процедуры до ее естественного окончания
End If
'Проверяем, введено ли имя
If .txtName.Text = "" Then
MsgBox "Вы забыли указать имя", vbExclamation
Exit Sub
End If
'Проверяем, введено ли отчество
If .txtName1.Text = "" Then
MsgBox "Вы забыли указать отчество", vbExclamation
Exit Sub
End If
'Проверяем, введен ли адрес
If .TxtAdres.Text = "" Then
MsgBox "Вы забыли указать адрес", vbExclamation
Exit Sub
End If
'Присваиваем значения переменным в элементах TextBox
fam = .txtFamil.Text
nam = .txtName.Text
otc = .txtName1.Text
adr = .TxtAdres.Text
'Проверяем, введено ли текущее показание счетчика
If IsNumeric(.txttekpok.Text) = False Then
MsgBox "Введено неверное показание счетчика", vbExclamation
Exit Sub
End If
tekpok = CSng(.txttekpok.Text)
'Проверяем, введено ли текущее показание счетчика
If IsNumeric(.txttekpok1.Text) = False Then
MsgBox "Введено неверное показание счетчика", vbExclamation
Exit Sub
End If
tekpok1 = CSng(.txttekpok1.Text)
'Проверяем, введено ли предыдущее показание счетчика
If IsNumeric(.txtprpok.Text) = False Then
MsgBox "Введено неверное показание счетчика", vbExclamation
Exit Sub
End If
prpok = CSng(.txtprpok.Text)
'Проверяем, введено ли предыдущее показание счетчика
If IsNumeric(.txtprpok1.Text) = False Then
MsgBox "Введено неверное показание счетчика", vbExclamation
Exit Sub
End If
prpok1 = CSng(.txtprpok1.Text)
'Проверяем, введен ли тариф х/в
If IsNumeric(.txttarif.Text) = False Then
MsgBox "Введен неверный тариф", vbExclamation
Exit Sub
End If
tarif = CSng(.txttarif.Text)
If Val(txtprpok1.Text) > Val(txttekpok1.Text) Then
MsgBox "Предыдущее показание счетчика больше текущего", vbExclamation
Exit Sub
End If
End With
'Проверяем, введен ли тариф г/в
If IsNumeric(txttarif2.Text) = False Then
MsgBox "Введен неверный тариф", vbExclamation
Exit Sub
End If
tarif2 = CSng(txttarif2.Text)
If Val(txtprpok.Text) > Val(txttekpok.Text) Then
MsgBox "Предыдущее показание счетчика больше текущего", vbExclamation
Exit Sub
End If
'Вычисляем расход воды и сумму оплаты
rashod = tekpok - prpok
rashod1 = tekpok1 - prpok1
rashod2 = rashod + rashod1
summa = rashod * tarif
rashod1 = tekpok1 - prpok1
summa1 = rashod1 * tarif2
summa2 = summa1 + summa
'Записываем данные в ячейки рабочего листа
With ActiveSheet
.Cells(nomer, 1).Value = fam
.Cells(nomer, 2).Value = nam
.Cells(nomer, 3).Value = otc
.Cells(nomer, 4).Value = adr
.Cells(nomer, 5).Value = tekpok
.Cells(nomer, 6).Value = tekpok1
.Cells(nomer, 7).Value = prpok
.Cells(nomer, 8).Value = prpok1
.Cells(nomer, 9).Value = tarif
.Cells(nomer, 10).Value = tarif2
.Cells(nomer, 11).Value = a
.Cells(nomer, 12).Value = rashod2
.Cells(nomer, 13).Value = summa2
End With
End Sub
 
Private Sub CommandButton2_Click()
Dim nomer As Integer
'Вычисляем номер последней строки
nomer = Application.CountA(ActiveSheet.Columns(1))
End With
End Sub
 
Private Sub CommandButton3_Click()
'Активизируем рабочий лист с именем Меню
Sheets("Меню").Activate
'Завершаем выполнение программы
End
End Sub
 
Private Sub CommandButton4_Click()
' Активизируем рабочий лист с именем Диаграмма
Sheets("Диаграмма").Activate
'Очищаем лист от всех объектов
For Each I In ActiveSheet.Shapes
I.Delete
Next I
' Создаем новую диаграмму
ActiveSheet.ChartObjects.Add(25, 25, 500, 300).Select
With ActiveChart
' Задаем тип диаграммы (объемная гистограмма)
.ChartType = xl3DBarClustered
' Находим, сколько записей в таблице
m = 2
Do
If Sheets("База").Cells(m, 1).Value = "" Then Exit Do
m = m + 1
Loop
m = m - 1
' Определяем источник данных для построения диаграммы:
' с листа «База» от ячейки I2 до ячейки IM
.SetSourceData Source:=Sheets("База").Range("M2:M" + Trim(Str(m))), PlotBy:=xlRows
' Выбираем подписи к данным из первого столбца таблицы
For m = 2 To N
.SeriesCollection(N - 1).Name = "=База!R" + Trim(Str(m)) + "C1"
Next
'Размещение диаграммы на отдельном листе
.Location Where:=xlLocationAsObject, Name:="Диаграмма"
With ActiveChart
' Заголовок
.HasTitle = True
.ChartTitle.Characters.Text = "Сумма оплаты за воду (в рублях)"
'Легенда
ActiveChart.ChartArea.Select
ActiveChart.FullSeriesCollection(1).Name = "=""Итоговая сумма"""
.HasDataTable = True
.Axes(xlCategory).MajorTickMark = xlNone
.Axes(xlCategory).MinorTickMark = xlNone
.Axes(xlCategory).TickLabelPosition = xlNone
End With
End With
End Sub
 
Private Sub Label6_Click()
 
End Sub
И вот код который находится в меню(так же если вам удобне то можете посмотреть в файле):
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
Private Sub ПриемПлатежа_Click()
'Вызываем процедуру формирования заголовков базы данных
ЗаголовокРабочегоЛиста
End Sub
 
Private Sub ЗаголовокРабочегоЛиста()
'Активизируем рабочий лист
Application.Worksheets("База").Activate
'Проверяем, есть ли названия столбцов. В противном случае вносим их
With ActiveSheet
If .Range("A1").Value = "Фамилия" Then
.Range("A2").Select
Else
'Очищаем рабочий лист
ActiveSheet.Cells.Clear
'Записываем названия столбцов
Application.Worksheets("База").Range("A1:M1").Select
With Selection
.Value = Array("Фамилия", "Имя", "Отчество", "Адрес", "Текущеепоказание счетчика холодной водыв м^3", "Текущеепоказание счетчика горячей воды в м^3", "Предыдущее показание счетчика холодной воды в м^3", "Предыдущее показание счетчика горячей воды в м^3", "Тариф х/в в Рубхлях", "Тариф г/в в Рубхлях", "Дата платежа", "Объём водопотребления в м^3", "Сумма общаая в рублях")
.Interior.ColorIndex = 8
.Font.Bold = True
End With
'Вставляем комментарии
.Range("A1").AddComment
.Range("A1").Comment.Visible = False
.Range("A1").Comment.Text Text:="Фамилия клиента"
.Range("B1").AddComment
.Range("B1").Comment.Visible = False
.Range("B1").Comment.Text Text:="Имя клиента"
.Range("C1").AddComment
.Range("C1").Comment.Visible = False
.Range("C1").Comment.Text Text:="Отчество клиента"
.Range("D1").AddComment
.Range("D1").Comment.Visible = False
.Range("D1").Comment.Text Text:="Адрес клиента"
.Range("E1").AddComment
.Range("E1").Comment.Visible = False
.Range("E1").Comment.Text Text:="Текущее показание счетчика холодной воды в м^3"
.Range("F1").AddComment
.Range("F1").Comment.Visible = False
.Range("F1").Comment.Text Text:="Текущее показание счетчика горячей воды в м^3"
.Range("G1").AddComment
.Range("G1").Comment.Visible = False
.Range("G1").Comment.Text Text:="Предыдущее показание счетчика холодной воды в м^3"
.Range("H1").AddComment
.Range("H1").Comment.Visible = False
.Range("H1").Comment.Text Text:="Предыдущее показание горячей воды счетчика в м^3"
.Range("I1").AddComment
.Range("I1").Comment.Visible = False
.Range("I1").Comment.Text Text:="Тариф х/в в Рубхлях"
.Range("J1").AddComment
.Range("J1").Comment.Visible = False
.Range("J1").Comment.Text Text:="Тариф г/в в Рубхлях"
.Range("K1").AddComment
.Range("K1").Comment.Visible = False
.Range("K1").Comment.Text Text:="Дата платежа"
.Range("L1").AddComment
.Range("L1").Comment.Visible = False
.Range("L1").Comment.Text Text:="Объём водопотребления в м^3 "
.Range("M1").AddComment
.Range("M1").Comment.Visible = False
.Range("M1").Comment.Text Text:="Общая сумма платежа в руб"
End If
End With
'Форматирование табличных ячеек
Worksheets("База").Range("A:M").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
End With
'Вызвать на экран форму
UserForm1.Show
End Sub
Мне нужно что бы на форме была фамилия клиента там, итоговая сумма, дата платежа и объём водопотребления(который предпоследний в базе)
0
YTGoodFox
0 / 0 / 0
Регистрация: 30.04.2019
Сообщений: 20
16.07.2019, 08:34  [ТС] 6
Спасибо, вы правда сделали то что надо, простите что не проверил сначала. Но есть вопросик: можно что бы вместо конкретного ряда была фамилия? как это реализовать?
0
16.07.2019, 08:34
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
16.07.2019, 08:34

Диаграммы Excel
Подскажите, пожалуйста, с помощью каких свойств можно изменить цвет линии графика(с красного на...

Построение диаграммы макросом
День добрый. Мои познания в Visual basic не очень сильны, прошу сильно не агриться. Необходимо с...

Размещение диаграммы на форме
Столкнулся с довольно непростой задачей вставка диаграммы(MS Excel) на форму. Знаю только то, что...


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

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

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