Range.Characters對象在循環中無法正常工作

Question

下面是Excel VBA中的一個程序，它創建一個進度指示器。我試圖讓進度指示器儘可能簡單，但通過使用Unicode字符仍然看起來很優雅：full block和thin space。

Private Sub Play_Click() 
Dim iCounter As Long, iRow As Long, nRow As Long, _ 
    Block As String, Progress As Long, iChar As Long 

Columns(1).ClearContents 

With Cells(2, 4) 
    .ClearContents 
    .Font.Color = vbBlue 
    nRow = 100 

    For iRow = 1 To nRow 
     For iCounter = 1 To 100 
      Cells(iRow, 1) = iCounter 
     Next 

     Progress = Int(iRow/10) 
     If Progress = iRow/10 Then 
      Block = Block & ChrW(9608) & ChrW(8201) 
      '------------------ 
      'Option statements 
      '------------------ 
     End If 

     .Value = Block & " " & iRow & " %" 
    Next 
End With 
End Sub 

我想有進度指示器看起來像這樣

其中全塊總是綠色的和百分比數總是在程序藍色正在運行。但是，使用這三個選項的語句，

選項1

.Characters(, 2 * Progress - 1).Font.Color = vbGreen 

選項2

 For iChar = 1 To Len(.Value) 
      If Mid$(Text, iChar, 1) = ChrW(9608) Then 
       .Characters(iChar, 1).Font.Color = vbGreen 
      End If 
     Next 

選項3

GreenBlue 2 * Progress - 1 

--------------------- 

Sub GreenBlue(GreenPart As Integer) 

Select Case GreenPart 
    Case 1 To 19 
     Cells(2, 4).Characters(, GreenPart).Font.Color = vbGreen 
End Select 

End Sub 

我一直得到下面的輸出

什麼是讓喜歡第一張照片的輸出正確的方式？

Answer 1

每當您替換單元格的值時，所有新內容都會從要替換的第一個字符中選取其格式，因此整個內容將變爲綠色：需要先將顏色設置回藍色，如果您想要數字部分爲藍色

Private Sub Play_Click() 
Dim iCounter As Long, iRow As Long, nRow As Long, _ 
    Block As String, Progress As Long, iChar As Long, x As Long 

Columns(1).ClearContents 

With Cells(2, 4) 
    .ClearContents 
    .Font.Color = vbBlue 
    nRow = 100 

    For iRow = 1 To nRow 
     For iCounter = 1 To 100 
      Cells(iRow, 1) = iCounter 
     Next 

     Progress = Int(iRow/10) 
     If Progress = iRow/10 Then 
      Block = Block & ChrW(9608) & ChrW(8201) 
     End If 


     Application.ScreenUpdating = False 'reduce flashing during update 
     .Value = Block & " " & iRow & " %" 
     .Font.Color = vbBlue 
     If Len(Block) > 0 Then 
      .Characters(1, InStr(.Value, " ")).Font.Color = vbGreen 
     End If 
     Application.ScreenUpdating = True 

     'add some delay... 
     For x = 1 To 1000 
      DoEvents 
     Next x 


    Next 
End With 
End Sub