Страницы: 1
RSS
Поменять макросом начало оси диаграммы "каскад", Поменять макросом начало оси
 
Доброго времени суток, коллеги.
Задача: нужно дописать макрос, позволяющий менять начальную точку вертикальной оси (присваивать ей круглое значение, расположенное максимально рядом с первым значением диаграммы). Макрос работает уже с готовым каскадным графиком
Формулу расчета и логику я написал на VBA (для расчета значения этой точки и присвоения ее минимальному по вертикальной оси). С определением диапазона мне немного помогли, но проблема в том, что я не могу продвинуться дальше, не получается выдернуть стартовую точку из диапазона. Поэтому мой код не работает. Вложил файл с кодом, на таблице "info" разместил визуальный пример того, что нужно получить.
Пожалуйста, помогите исправить ошибки.
Вопрос о том, почему нельзя руками менять шкалу - не ко мне, так поставили задачу.

Всех заранее от всей души благодарю!
 
McClane,
почему Вы не запишете данные действия?

вариант:
Код
Sub a()
y1 = Application.Min([C25,C20])
y2 = Application.Min([C26:C28])
    With ActiveSheet.ChartObjects("Диаграмма 1").Chart.Axes(xlValue)
    .MinimumScale = y1 + y2
End With
End Sub
Изменено: evgeniygeo - 28.09.2022 14:29:39
 
evgeniygeo,

Дело в том, что диаграмм на вкладке может быть несколько. В силу этого, я привязывался к активной.
Диапазон значений тоже может быть в любом месте. Поэтому и не стал привязываться к каким-либо ячейкам.
Я правильно Вас понял?
 
McClane,
может так.
Сорри, проверил, работает только на гистограмме. С каскадной не фурычит
как будто у каскадной нет форомулы:
Код
cht.SeriesCollection(series).Formula


Код
Sub Dimension()
Dim razryad As Double, w As String, c As Integer, r As Integer, q As Double, ch_name As String, a As Range, ch As Chart
w = ActiveSheet.Name
ch_name = Replace(ActiveChart.Name, w & " ", "")
Set ch = Sheets(w).ChartObjects(ch_name).Chart
On Error Resume Next
If ch Is Nothing Then
MsgBox "You haven't chosen the Chart"
Exit Sub
End If
GetChartRange(ch, 1, "Values").Select 'выделяю диапазон значений для графика через функцию
Set a = Selection 'передаю выделенный диапазон графика
Debug.Print a.Cells.Row 'ищу номер первой строки диапазона
r = a.Cells.Row 'передаю номер строки диапазона в переменную
c = a.Cells.Column 'передаю координаты столбца первого значения в переменную
razryad = 0
razryad = Cells(r, c).Value / 1000000000 'проверяю относится ли значение к 1 000 000 000
ActiveSheet.ChartObjects(ch_name).Activate
If razryad > 1 Then 'проверяю отношение к 1 000 000 000 razry
ActiveChart.Axes(xlValue).MinimumScale = "1000000000" 'вношу минимальное значение по вертикальной оси
Exit Sub
Else: razryad = Cells(r, c).Value / 1000000
End If
If razryad > 1 Then 'проверяю отношение к 1000000
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) * 1000000 'исправляю первоначальное координату
Exit Sub
Else: razryad = Cells(r, c).Value / 100000 'проверяю отношение к 100000
End If
If razryad > 1 Then
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) * 100000 'меняю значение старта оси
Exit Sub
Else: razryad = Cells(r, c).Value / 10000 'проверяю отношение к 10000
End If
If razryad > 1 Then
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) * 10000 'исправляю значение старта оси
Exit Sub
Else: razryad = Cells(r, c).Value / 1000 ' проверяю отношение к 1000
End If
If razryad > 1 Then
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) * 1000 'вносим новое координатное значение
Exit Sub
Else: razryad = Cells(r, c).Value / 100 '  проверяю отношение к 100
End If
If razryad > 1 Then
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) * 100 '  новая координата
Exit Sub
Else: razryad = Cells(r, c).Value / 10 ' проверяю отношение к 10
End If
If razryad > 1 Then
ActiveChart.Axes(xlValue).MinimumScale = Round(razryad, 0) ' новое значение в шкале
End If
End Sub
Изменено: evgeniygeo - 29.09.2022 08:44:11
 
Evgeniygeo, Вы гений!

Пожалуйста, подскажите, Formula позволяет при обращении к ней выгрузить номера ячеек данных?

Спасибо за ответ и за Вашу помощь!
 
McClane,
на сколько я вижу, в случае с гистограммой из GetChartRange мы в итоге получаем номер строки и столбца, но с каскадной диаграммой функция не работает.
Я бы пошел более простым путем и сделал бы каскадную диаграмму из гистограммы

Возможно, более опытные форумчане смогут помочь с текущими данными  ;)
Изменено: evgeniygeo - 29.09.2022 12:39:59
 
В любом случае, вопрос с исправлением мы решили.

Огромное Вам спасибо!
Страницы: 1
Наверх