Почему индикатор не показывает прогресс на панели? - PullRequest
0 голосов
/ 06 ноября 2019

Мой индикатор выполнения не работает, я не знаю, как показать индикатор выполнения

Я уже пытался изменить, где заканчивается цикл

Sub ShowUserForm()

    UserForm1.Show

End Sub



Sub Main()

    Dim Counter As Integer

    Dim PctDone As Single

    Dim RngToCheck As Range, RngToPaste As Range

    Set RngToCheck = Application.InputBox(Prompt:="Enter range", Type:=8)

    Dim inttofind As String

    inttofind = InputBox("Give your indicator")





Application.ScreenUpdating = False

    Counter = 1



    Dim i As Long

        For i = RngToCheck.Rows.Count To 1 Step -1

            If RngToCheck(i).Value = inttofind Then

                RngToCheck(i).Offset(1).EntireRow.Insert

                Set RngToPaste = RngToCheck(i).Offset(1)

                CopyAlmostEntireRow RngToCheck(i), RngToPaste

                RngToPaste.EntireRow.Font.Color = RGB(255, 0, 0)

                Counter = Counter + 1

        End If

        Next i



        PctDone = i / RngToCheck.Rows.Count



        UpdateProgressBar PctDone

    Unload UserForm1

End Sub



Sub UpdateProgressBar(PctDone As Single)

    With UserForm1



        .FrameProgress.Caption = Format(PctDone, "0%")

        .LabelProgress.Width = PctDone * _

            (.FrameProgress.Width - 10)

    End With



    DoEvents

End Sub

Sub CopyAlmostEntireRow(FromRow As Range, ToRow As Range)

    Dim FromRange As Range

    Dim ToRange As Range



    Set FromRange = FromRow.Worksheet.Range("A" & FromRow.Row & ":AR" & FromRow.Row)

    Set ToRange = ToRow.Worksheet.Range("A" & ToRow.Row & ":AR" & ToRow.Row)

    ToRange.Value = FromRange.Value



    Set FromRange = FromRow.Worksheet.Range("AV" & FromRow.Row & ":ED" & FromRow.Row)

    Set ToRange = ToRow.Worksheet.Range("AV" & ToRow.Row & ":ED" & ToRow.Row)

    ToRange.Value = FromRange.Value





End Sub
...