VBA - 我的代碼沒有着色或改變形式，但「忘記」做兩個

Question

我遇到了一些問題，我一直在嘗試對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 

現在，這是我在遇到麻煩的時候我寫什麼如下，擅長它只是把顏色忘記，只是記住改變形式

' 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 

最後，我有一個情節只有紅點和不同的形式。 你知道我出錯了嗎？ 感謝您的幫助

Answer 1

在第一個循環中，您將值分配給變量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