Изменение формы конкретных точек в точечной диаграмме Excel на основе значений - PullRequest
Новая
       11

Изменение формы конкретных точек в точечной диаграмме Excel на основе значений

0 голосов
/ 19 сентября 2018

Мне нужна точечная диаграмма, чтобы настроить цвет и форму маркеров на основе различных значений.Я нашел код ниже и отлично работает для изменения цвета. Можно ли настроить этот код или новый, чтобы маркер имел круги, треугольники, квадраты и т. Д. На основе другого значения столбца?

Tnx! 

Sub ColorScatterPoints3()
    Dim cht As Chart
    Dim srs As Series
    Dim pt As Point
    Dim p As Long
    Dim Vals$, lTrim#, rTrim#
    Dim valRange As Range, cl As Range
    Dim myColor As Long

    Set cht = ActiveSheet.ChartObjects(1).Chart
    Set srs = cht.SeriesCollection(1)

   '## Get the series Y-Values range address:
    lTrim = InStrRev(srs.Formula, ",", InStrRev(srs.Formula, ",") - 1, vbBinaryCompare) + 1
    rTrim = InStrRev(srs.Formula, ",")
    Vals = Mid(srs.Formula, lTrim, rTrim - lTrim)
    Set valRange = Range(Vals)

    For p = 1 To srs.Points.Count
        Set pt = srs.Points(p)
        Set cl = valRange(p).Offset(0, 1) '## assume color is in the next column.

        With pt.Format.Fill
            .Visible = msoTrue
            '.Solid  'I commented this out, but you can un-comment and it should still work
            '## Assign Long color value based on the cell value
            '## Add additional cases as needed.
            Select Case LCase(cl)
                Case "red"
                    myColor = RGB(255, 0, 0)
                Case "blue"
                    myColor = RGB(0, 0, 255)
                Case "green"
                    myColor = RGB(0, 255, 0)
                    Case "yellow"
                    myColor = RGB(255, 192, 50)

            End Select

            .ForeColor.RGB = myColor

        End With
    Next
End Sub

1 Ответ

0 голосов
/ 19 сентября 2018

Нечто подобное должно работать.Я на самом деле немного узнал, исследуя ответ.Я не знал, как использовать Select Case.Спасибо, что задали вопрос!

Если вы хотите добавить больше параметров формы, см. Эту статью: https://docs.microsoft.com/en-us/office/vba/api/excel.series.markerstyle

Мой пример данных и результата: Example Chart

Sub ColorScatterPoints3()
    Dim cht As Chart
    Dim srs As Series
    Dim pt As Point
    Dim p As Long
    Dim Vals$, lTrim#, rTrim#
    Dim valRange As Range, cl As Range
    Dim myColor As Long
    Dim myShape As String

    Set cht = ActiveSheet.ChartObjects(1).Chart
    Set srs = cht.SeriesCollection(1)

   '## Get the series Y-Values range address:
    lTrim = InStrRev(srs.Formula, ",", InStrRev(srs.Formula, ",") - 1, vbBinaryCompare) + 1
    rTrim = InStrRev(srs.Formula, ",")
    Vals = Mid(srs.Formula, lTrim, rTrim - lTrim)
    Set valRange = Range(Vals)

    For p = 1 To srs.Points.Count
        Set pt = srs.Points(p)
        Set cl = valRange(p).Offset(0, 1) '## assume color is in the next column.
        Set shp = valRange(p).Offset(0, 2) '## assume shape is in column next to color.

        'Color Change
        With pt.Format.Fill
            .Visible = msoTrue
            '.Solid  'I commented this out, but you can un-comment and it should still work
            '## Assign Long color value based on the cell value
            '## Add additional cases as needed.
            Select Case LCase(cl)
                Case "red"
                    myColor = RGB(255, 0, 0)
                Case "blue"
                    myColor = RGB(0, 0, 255)
                Case "green"
                    myColor = RGB(0, 255, 0)
                    Case "yellow"
                    myColor = RGB(255, 192, 50)

            End Select

            .ForeColor.RGB = myColor

        End With

        'Shape Change
        With pt
            '## Assign shape value based on the cell value
            '## Add additional cases as needed.
            Select Case LCase(shp)
                Case "square"
                    myShape = xlMarkerStyleSquare
                Case "triangle"
                    myShape = xlMarkerStyleTriangle
                Case "circle"
                    myShape = xlMarkerStyleCircle
                Case "x"
                    myShape = xlMarkerStyleX
                Case "+"
                    myShape = xlMarkerStylePlus

            End Select

            .MarkerStyle = myShape

        End With

    Next
End Sub
...