VBA - 我的代码可以着色或改变形式,但是"忘记"做两件事

时间:2016-06-15 10:25:31

标签: excel vba charts

我在excel上试图做的事情有些问题:我写了一些关于我的信息,我在互联网上发现的一点点我被卡住了 - 创建图表(散点图)并应显示具有不同颜色的点,具体取决于y值旁边的列中的值,并且具有不同的Markerstyle,具体取决于稍远一列中的值。但是,它只记得做我提出的一件事。

Sub Figure2()
'
' Figure2 Macro
Dim i As Integer
Dim j As Integer
Dim LastColumn As Long
Dim LastRow As Long
Dim u As Integer
Dim NameRng As String
Dim CountsRng As Range
Dim xRng As Range
Dim x As Long

LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ColumnCount = LastColumn
LastRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
' Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & "   LastRow: " & LastRow)

' Création du graph
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Range("Feuil3!$A$1:$B$" & LastRow)
ActiveChart.Legend.Select
Selection.Delete

' For colors
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 srsi As Series
Dim pti As Point
Dim pi As Long

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

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)
' where to go for values
    Set cl = valRange(p).Offset(0, 1)
    With pt.Format.Fill
        .Visible = msoTrue
       Select Case LCase(cl)
' changing color for the one next to its cell
            Case "red"
                myColor = RGB(217, 0, 18)
            Case "blue"
                myColor = RGB(77, 63, 255)
            Case "green"
                myColor = RGB(28, 210, 32)
        End Select
    End With
    Next
' Everything working so far, with the graph and the right colors

现在这就是我遇到麻烦的地方,因为当我写下以下内容时,excel会忘记它刚刚放置的颜色,只记得改变形式

' Changing MarkerStyle

    Set srsi = cht.SeriesCollection(1)
    For pi = 1 To srsi.Points.Count
    Set pti = srsi.Points(pi)
' where to go for values

这次它应该转到另一列

之前的那一列
    Set cli = valRange(pi).Offset(0, 3)
    With pti.Format.Fill
        .Visible = msoTrue
       Select Case LCase(cli)
' going three columns from here
            Case "boxer"
' changing
                 pti.MarkerStyle = xlMarkerStyleDiamond
                 pti.MarkerSize = 7
            Case ""
                 pti.MarkerStyle = xlMarkerStyleCircle
                 pti.MarkerSize = 6
            Case "ea390/398"
                 pti.MarkerStyle = xlMarkerStyleTriangle
                 pti.MarkerSize = 6
        End Select
    End With
Next

End Sub

最后,我有一个只有红点和不同形式的情节。 你知道我哪里出错吗? 谢谢你的帮助

1 个答案:

答案 0 :(得分:0)

在第一个循环中,您要为变量myColor赋值,但后来却没有对该变量进行任何操作。您需要为该点指定颜色。

替换

With pt.Format.Fill
        .Visible = msoTrue
       Select Case LCase(cl)
' changing color for the one next to its cell
            Case "red"
                myColor = RGB(217, 0, 18)
            Case "blue"
                myColor = RGB(77, 63, 255)
            Case "green"
                myColor = RGB(28, 210, 32)
        End Select
    End With

With pt.Format.Fill
        .Visible = msoTrue
       Select Case LCase(cl)
' changing color for the one next to its cell
            Case "red"
                myColor = RGB(217, 0, 18)
            Case "blue"
                myColor = RGB(77, 63, 255)
            Case "green"
                myColor = RGB(28, 210, 32)
        End Select
        .BackColor.RGB = myColor
        .ForeColor.RGB = myColor
    End With