powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / группировка диаграмм
21 сообщений из 21, страница 1 из 1
группировка диаграмм
    #36941744
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
добрый день!
есть небольшой код, он пробегается по всем группам на листе excel и вычисляет максимальное число по оси значений в пределах данной группы (она, как правило, состоит из 2 диаграмм)

в идеале, данный код также должен заменят иные числа оси значений, отличные от максимума на найденный максимум (опять же, в пределах группы). этого не происходит, т.к. не получается заново запустить цикл For Each j In Selection. подскажите, пожалуйста, что можно придумать
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
Sub Макрос2()
Dim i As Shape
Dim j As Object
Dim max As Long
k =  0 
For Each i In ThisWorkbook.Worksheets("pivotTables").Shapes
    i.Ungroup.Select
        max =  0 
            For Each j In Selection
                Debug.Print j.Name
                    ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
                    If max < ActiveChart.Axes(xlValue).MaximumScale Then
                        max = ActiveChart.Axes(xlValue).MaximumScale
                    End If
            Next j
'''''''''''''''''''''''''''''''''''''
            For Each j In Selection
                ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
                ActiveChart.Axes(xlValue).MaximumScale = max
            Next j
    Selection.ShapeRange.Regroup
Next i
End Sub
...
Рейтинг: 0 / 0
группировка диаграмм
    #36941760
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Избавиться от Select и Selection
...
Рейтинг: 0 / 0
группировка диаграмм
    #36941790
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
да, так и сделал
а как проверить, являетется ли shape группой?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
Sub макрос4()
Dim i As Shape
Dim j As Object

Dim max As Long
k =  0 
For Each i In ThisWorkbook.Worksheets("pivotTables").Shapes
    Debug.Print i.Name
        max =  0 
            For Each j In i.GroupItems
                Debug.Print j.Name
                    ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
                    If max < ActiveChart.Axes(xlValue).MaximumScale Then
                        max = ActiveChart.Axes(xlValue).MaximumScale
                    End If
            Next j
            For Each j In i.GroupItems
                ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
                ActiveChart.Axes(xlValue).MaximumScale = max
            Next j
Next i
End Sub
...
Рейтинг: 0 / 0
группировка диаграмм
    #36941850
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
в итоге, не стал заморачиваться и сделал так:
Код: plaintext
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.
Sub Макрос4()
Dim i As Shape
Dim j As Object
Dim max As Long
k =  0 
For Each i In ThisWorkbook.Worksheets("pivotTables").Shapes
    If InStr( 1 , i.Name, "Группа") <>  0  Then
        For Each j In i.GroupItems
            ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
            ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
            ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True
        Next j
        max =  0 
        For Each j In i.GroupItems
            ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
            If max < ActiveChart.Axes(xlValue).MaximumScale Then
                max = ActiveChart.Axes(xlValue).MaximumScale
            End If
        Next j
        For Each j In i.GroupItems
            ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
            ActiveChart.Axes(xlValue).MaximumScale = max
            ActiveChart.Axes(xlValue).MinimumScale =  0 
        Next j
    End If
Next i
End Sub
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942018
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: PlanB

У меня чисто теоретический вопрос: Активировать обязательно?
> ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate

Может можно сделать объектную переменную и оперировать ей?

[src vba]Set ch = ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name)
with ch.Axes(xlValue)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
end with
Ну и так далее по тексту.

К чему это, к тому, что всегда находится пользователь, который решит кликнуть по книге во время обработки и может
"сбить" активный объект. Это маловероятно, но! я на этом попадал всегда, поэтому сейчас не полагаюсь на активный объект.
К тому-же зачастую нужно что-то делать не показывая пользователю, а в таком режиме не все команды выделения срабатывают.

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942361
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь Горбоносу меня чисто теоретический вопрос: Активировать обязательно?блин, похоже, что обязательно. иначе, нифига работать не хочет.
ок, попробую. спасибо!

ps пользователь у меня, как в большинстве случаев, один я)) даж похвастаться не перед кем)))).
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942421
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
PlanBв итоге, не стал заморачиваться и сделал так:
End Sub[/src]

Правильнее все таки однозначно проверять является Shape группой или нет, т.к.
в различных версиях экселя по разному выдает названия Shape в VBA, где то по русски где то по английски, да и совпадение имени может быть.
Я думаю лучше к GroupItems обращаться и проверять каждый Shape, например считать элементы GroupItems.count, но тогда перехват ошибки делать нужно.
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942556
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Deggasad, я полностью согласен.
для меня, кстати, актуальна совместимость версий. т.е. данный макрос выполняется в 2007 excel. но сам шаблон забивается первоначальными данными в версии 2003. ещё не прикрутил всё до конца. если работать не захочет, придется ваять обработчик.
просто, как я уже отметил, "не стал заморачиваться".
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942644
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
PlanBИгорь Горбоносу меня чисто теоретический вопрос: Активировать обязательно?блин, похоже, что обязательно. иначе, нифига работать не хочет.

по идее это:
Код: plaintext
1.
2.
            ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Activate
            ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
            ActiveChart.Axes(xlValue).MinimumScaleIsAuto = True

меняется на это
Код: plaintext
1.
ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Chart.Axes(xlValue).MaximumScaleIsAuto = True
ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Chart.Axes(xlValue).MinimumScaleIsAuto = True
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942775
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: Shocker.Pro
> по идее это:
> меняется на это


Каждая точка, это дополнительные расходы на получение интерфейса и привидение к нужному типу :)

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942847
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
PlanBDeggasad, я полностью согласен.
для меня, кстати, актуальна совместимость версий. т.е. данный макрос выполняется в 2007 excel. но сам шаблон забивается первоначальными данными в версии 2003. ещё не прикрутил всё до конца. если работать не захочет, придется ваять обработчик.
просто, как я уже отметил, "не стал заморачиваться".
Код: plaintext
1.
2.
3.
4.
    Dim x As Long: x =  0 
    On Error Resume Next
     x = i.GroupItems.Count: Err.Clear
    On Error GoTo  0 
    If x >  0  Then
...
Рейтинг: 0 / 0
группировка диаграмм
    #36942861
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь Горбонос
Каждая точка, это дополнительные расходы на получение интерфейса и привидение к нужному типу :)
да неважно
если заработает, можно использовать With, главное, чтобы заработало
зато избавляемся от Activ(ate)
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944006
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь Горбонос
[src vba]Set ch = ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name)
with ch.Axes(xlValue)
.MaximumScaleIsAuto = True
.MinimumScaleIsAuto = True
end with
Ну и так далее по тексту.не лезет такая конструкция в переменную. пишет obj variable or block with variable not set
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944017
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
от Activate избавился по наводке.
не писал .chart, поэтому и не работал
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944093
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
так сделал
Код: plaintext
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.
Sub NormCharts()
Dim i As Shape
Dim j As Object
Dim max As Long
Dim x As Integer
Dim ch As Object

On Error Resume Next
Set ch = ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name)

For Each i In ThisWorkbook.Worksheets("pivotTables").Shapes
    x =  0 : x = i.GroupItems.Count
    If x >  0  Then
        For Each j In i.GroupItems
            ch.Chart.Axes(xlValue).MaximumScaleIsAuto = True
            ch.Chart.Axes(xlValue).MinimumScaleIsAuto = True
        Next j
        max =  0 
        For Each j In i.GroupItems
            If max < ch.Chart.Axes(xlValue).MaximumScale Then
                max = ch.Chart.Axes(xlValue).MaximumScale
            End If
        Next j
        For Each j In i.GroupItems
            ch.Chart.Axes(xlValue).MaximumScale = max
            ch.Chart.Axes(xlValue).MinimumScale =  0 
        Next j
    End If 'x > 0
Next i
Set ch = Nothing '?
End Sub
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944148
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
и нифига не работает:
Код: plaintext
1.
Set ch = ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name)
ch.Chart.Axes(xlValue).MaximumScaleIsAuto = True
зря я выпендривался.
тока вот так:
Код: plaintext
ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name).Chart.Axes(xlValue).MaximumScaleIsAuto = True
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944165
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
> Автор: PlanB
> и нифига не работает:


А скинь, плиз, книгу с чатами или какую-то подобную.

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944171
PlanB
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Игорь ГорбоносА скинь, плиз, книгу с чатами или какую-то подобную.
уфф, это оч. сложно
4info или 2helpme?
если второе - то и так работает, проще не заморачиваться =))
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944172
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
!!! неправильно воспользовался моим примером.
не нужно отказываться от сообщений об ощибках по любому поводу, это дурная привычка, отлавливайте только то, что нужно:

PlanBтак сделал
Код: plaintext
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.
Sub NormCharts()
Dim i As Shape
Dim j As Object
Dim max As Long
Dim x As Integer
Dim ch As Object

             'On Error Resume Next
Set ch = ThisWorkbook.Worksheets("pivotTables").ChartObjects(j.Name)

For Each i In ThisWorkbook.Worksheets("pivotTables").Shapes
    x =  0 
    On Error Resume Next
     x = i.GroupItems.Count: Err.Clear
    On Error GoTo  0 
    If x >  0  Then
        For Each j In i.GroupItems
            ch.Chart.Axes(xlValue).MaximumScaleIsAuto = True
            ch.Chart.Axes(xlValue).MinimumScaleIsAuto = True
        Next j
        max =  0 
        For Each j In i.GroupItems
            If max < ch.Chart.Axes(xlValue).MaximumScale Then
                max = ch.Chart.Axes(xlValue).MaximumScale
            End If
        Next j
        For Each j In i.GroupItems
            ch.Chart.Axes(xlValue).MaximumScale = max
            ch.Chart.Axes(xlValue).MinimumScale =  0 
        Next j
    End If 'x > 0
Next i
Set ch = Nothing '?
End Sub
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944278
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Deggasad,

+1
только Err.Clear там не нужен, следующая строка все равно его очищает
...
Рейтинг: 0 / 0
группировка диаграмм
    #36944450
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.ProDeggasad,

+1
только Err.Clear там не нужен, следующая строка все равно его очищает
действительно Err.Clear лишнее, можно удалить.
не помню откуда у меня эта привычка, но я же впринципе этим не пользуюсь, так понахватался где-то
...
Рейтинг: 0 / 0
21 сообщений из 21, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / группировка диаграмм
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]