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

Range.Characters对象在循环中没有按预期工作

1 个答案: