Построение диаграмм по выбору пользователя

Private Sub Command1_Click()
   ' Main "Gist"
  Main "Circle"
End Sub
 
Sub Main(ByVal S As String)
    Dim Arr(1 To 1000) As Byte, i As Integer, sum As Single ' тут добавил сумму
    Dim nArr(10) As Integer, max As Integer, min As Integer
    Randomize
    List1.Clear
    Picture1.Cls
    For i = 1 To 1000
        Arr(i) = Int(Rnd * 11)
        List1.AddItem Arr(i)
        nArr(Arr(i)) = nArr(Arr(i)) + 1
    Next i
    min = 1000
    For i = 0 To 10
        If nArr(i) > max Then max = nArr(i)
        If nArr(i) < min Then min = nArr(i)
        sum = sum + nArr(i)
    Next i
    Select Case S
           Case "Gist"
                Picture1.Scale (0, max + 10)-(111, 0)
                For i = 0 To 10
                    Picture1.Line (10 * i + 1, 8)-(10 * i + 10, nArr(i)), RGB((nArr(i) - min) * 20, max - nArr(i), (nArr(i) - min) * 5), BF
                    Picture1.CurrentX = Picture1.CurrentX - 8
                    Picture1.CurrentY = Picture1.CurrentY + 8
                    Picture1.Print nArr(i)
                    Picture1.CurrentY = 8: Picture1.CurrentX = 10 * i + 4
                    Picture1.Print i
                Next i
             Case "Circle"    ' тут само построение круговой диаграммы
                   Dim a As Single, b As Single
                   Picture1.Scale (-10, 10)-(10, -10)
                   Picture1.FillStyle = vbFSSolid
                 For i = 0 To 10
                     b = b + 6.28 * nArr(i) / sum
                     Picture1.FillColor = QBColor(i) ' Мне эти цвета не понравились-> : RGB((nArr(i) - min) * 20, max - nArr(i), (nArr(i) - min) * 5)
                     Picture1.Circle (0, 0), 5, , -a, -b
                     a = a + 6.28 * nArr(i) / sum
                 Next i
             
    End Select
End Sub
 
Private Sub Command2_Click()
End
End Sub

Private Sub ДИАГРАММА() 'построение диаграммы
On Error GoTo Error_Metka 'перехват ошибки работы программы без базы
Dim J As Byte ' переменная цикла
Dim Z As Byte ' текущий цвет QBColor(0 - 15)
Dim N As Integer ' внутренний радиус
Dim K As Integer ' внешний радиус
Dim A As Single ' переменная угла (рад)
Dim An As Single ' переменная угла (рад) начало текущего сегмента
Dim Ak As Single ' переменная угла (рад) конец текущего сегмента
Dim R As Single ' переменная номер рабочего
Dim Av As Single ' переменная угла вращения(рад)
 
With SVEDEN 'выбрать таблицу
Cls ' очистить форму
Select Case GR ' проверить состояние флага
 
Case True 'если установлен
Do
Cls ' очистить форму
For J = 1 To .Rows - 1 'по всем строкам таблицы
.Col = 4 ' назначаем столбец
.Row = J - 1 'назначаем строку
.CellBackColor = QBColor(J) ' назначаем цвет ячейке
Next J 'следующая строка
N = 1000 ' внутренний диаметр диаграммы
K = 5000 ' наружный диаметр диаграммы
Z = 1 'первый цвет диаграммы
For R = 1 To UBound(Mz) ' по всему списку рабочих цеха
Ak = An + Mz(R) * 2 * Pi / SUM 'вычисляем текущий угол  пропорционально зарплате
            For A = An To Ak Step 0.01 ''от предыдущего до текущего с шагом 0.01
            Line (N * Sin(A), N * Cos(A))-(K * Sin(A), K * Cos(A)), QBColor(Z)     ' приводим линии
            Next A 'следующий угол
            Me.CurrentX = (K - N) * Sin(An) 'устанавливаем координату X надписи
            Me.CurrentY = (K - N) * Cos(An) 'устанавливаем координату Y надписи
            Print SVEDEN.TextMatrix(R - 1, 2) 'печатаем фамилию
   An = Ak 'запоминаем значение угла
Z = Z + 1 'следующий цвет
Next R 'следующий рабочий цеха
DoEvents
Av = Av + 0.01 'наращиваем угол поворота
An = Av 'назначаем начальный угол
Loop While Вращать.Value = 1
 
Case False 'если флаг не установлен
For J = 1 To .Rows - 1 'по всем строкам таблицы
.Col = 4 ' назначаем столбец
.Row = J - 1 'назначаем строку
.CellBackColor = .BackColor 'назначаем исходный цвет исходный цвет
Next J 'следующая строка
Error_Metka: '
End Select 'конец выбрать
End With 'выход из выбрать таблицу
End Sub