Макрос окрашивания круговой диаграммы

@Radu1 · Регистрация: 22.05.2017

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

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

наверно, это элементарщина - сильно не бейте) с макросами второй день как познакомился

@pashulka · 23.05.2017, 20:08

Можно, например, так :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Test()
    Dim r As Range, p As Point, i&
    Set r = ThisWorkbook.Worksheets("Data").[B4:C7]
    
    With ThisWorkbook.Worksheets("Diagram")
         With .ChartObjects.Add(.[B2].Left, .[B2].Top, 600, 400).Chart
              .ChartType = xlPie
              .SetSourceData r
              For Each p In .SeriesCollection(1).Points
                  i = i + 1: p.Interior.Color = r(i, 2).Interior.Color
              Next
         End With
    End With
End Sub

@Radu1 · 24.05.2017, 15:31 **[ТС]**

pashulka,все гениальное просто!!огромное вам спасибо, что откликнулись
с привязкой к заливкам теперь разобрался

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

- если ячейка B4 ='Black' то залить соответствующую ей часть на диаграмме черным итд

по сути это что-то типа такого?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
For i = 4 To lLastRow
Select Case Cells(i, 2)
Case Is = Black
.SeriesCollection(1).Points (i - 2): p.Interior.Color = vbBlack
Case Is = Green
.SeriesCollection(1).Points (i - 2): p.Interior.Color = vbGreen
Case Is = Red
.SeriesCollection(1).Points (i - 2): p.Interior.Color = vbRed
Case Is = Yellow
.SeriesCollection(1).Points (i - 2): p.Interior.Color = vbYellow
End Select
 
Next i

поправьте, пожалуйста.

@pashulka · 24.05.2017, 16:55

Если Вы считаете, что перебирать нужно именно строки, а не точки, то :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim ws As Worksheet, i&
Set ws = ThisWorkbook.Worksheets("Data")
 
For i = 4 To lLastRow
    Select Case ws.Cells(i, 2)
        Case "Black"
           .SeriesCollection(1).Points(i - 3).Interior.Color = vbBlack
        Case "Green"
           .SeriesCollection(1).Points(i - 3).Interior.Color = vbGreen
        Case "Red"
           .SeriesCollection(1).Points(i - 3).Interior.Color = vbRed
        Case "Yellow"
           .SeriesCollection(1).Points(i - 3).Interior.Color = vbYellow
    End Select
Next

или так :

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Dim ws As Worksheet, i&, c&
Set ws = ThisWorkbook.Worksheets("Data")
 
For i = 4 To lLastRow
    Select Case ws.Cells(i, 2)
        Case "Black":  c = vbBlack
        Case "Green":  c = vbGreen
        Case "Red":    c = vbRed
        Case "Yellow": c = vbYellow
        Case Else:     c = vbWhite
    End Select
    .SeriesCollection(1).Points(i - 3).Interior.Color = c
Next

@Radu1 · 24.05.2017, 17:28 **[ТС]**

перебирать точки было бы правильнее? или это равноправные методы?

@pashulka · 24.05.2017, 17:50

Если строк окажется больше, чем точек, возникнет ошибка.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11680&d=1772460536 Одним из. . .	Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .
SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .

@Radu1 0 / 0 / 0 Регистрация: 22.05.2017 Сообщений: 3
	24.05.2017, 17:28 [ТС]
	перебирать точки было бы правильнее? или это равноправные методы? 0

@pashulka 4139 / 2243 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	24.05.2017, 17:50
	Если строк окажется больше, чем точек, возникнет ошибка. 0