Как хранить / группировать вместе / манипулировать константами с плавающей точкой в ​​VBA - PullRequest
0 голосов
/ 12 апреля 2019

Я использую Visio-2016 VBA. В моем главном модуле я должен нарисовать около десяти прямоугольников на страницу Visio. 32 страницы повторяются в цикле For. Различные свойства для прямоугольников также должны быть установлены для каждого прямоугольника, такие как Граница или Без полей.

Функция DrawRectangle () должна иметь пары координат прямоугольника в виде X1, Y1, X2, Y2 Мои значения в константах Double (с плавающей запятой двойной точности).

Я старался изо всех сил хранить и группировать эти пары координат как константы, но безрезультатно.

Пример пары координат для одной прямоугольной формы:

X1 = 3,179133858

Y1 = 1,181102362

X2 = 6,131889764

Y2 = 1,57480315

Я попробовал следующие вещи, чтобы сгруппировать пары координат по крайней мере для десяти прямоугольников, но безуспешно: - Простой список констант в верхней части основной подпрограммы (не хочу) - Перечислимый список (работает только для длинных типов данных) - Массив или двумерный массив (неудобно, установить / вернуть значение только по индексу массива) - Тип ... Тип конца (работает, но Ошибка при создании коллекции / словаря)

Вот часть кода из класса, который я пытаюсь создать

Public Type CoordRectType
          X1 As Double
          Y1 As Double
          X2 As Double
          Y2 As Double
End Type

Public RectLftBtm As CoordRectType
Public RectLftTop As CoordRectType
Public colRect As Collection

Sub TestIt()
' Create instances of UDT as required
' LEFT-BOTTOM BarCode     [vsoShape1]
      RectLftBtm.X1 = 3.179133858
      RectLftBtm.Y1 = 1.181102362
      RectLftBtm.X2 = 6.131889764
      RectLftBtm.Y2 = 1.57480315

' LEFT-TOP  BarCode     [vsoShape2]
      RectLftTop.X1 = 3.179133858
      RectLftTop.Y1 = 1.181102362
      RectLftTop.X2 = 6.131889764
      RectLftTop.Y2 = 1.57480315

colRect.Add RectLftBtm , "LeftBottomRect"   ''' Compiler Error here ''''''
colRect.Add RectLftTop , "LeftTopRect"      ''' Compiler Error here '''''' 

End Sub

''' .... REST OF THE CODE FOR CLASS ......
' ///////////////////////////////////////////

Я также пытался заменить Collection на Dictionary в приведенном выше коде, но с той же ошибкой компилятора

Я хочу хранить все данные пар координат, предпочтительно в виде констант (если это невозможно, чем в переменных) внутри модуля класса. Из основной подпрограммы я затем установлю свойства класса и вызову методы в итерации, чтобы создать прямоугольные формы по мере необходимости, и все же мой основной модуль будет аккуратным и чистым

Один дополнительный вопрос в последнем: Имеет ли константа какого-либо встроенного (встроенного VBA) типа данных то же использование памяти, что и переменной этого типа данных?

1 Ответ

2 голосов
/ 13 апреля 2019

Вы были так близко. Одним из способов решения этой проблемы является создание класса прямоугольника с использованием методов Create / Self для самоинстанцируемых объектов

Это класс прямоугольника

Option Explicit

Private Type Properties

    X1                      As Double
    X2                      As Double
    Y1                      As Double
    Y2                      As Double
    ' extend this pattern to include any other parameters relevant to drawing the rectangle
End Type

Private p                   As Properties

Public Function Create _
( _
    ByVal X1 As Double, _
    ByVal Y1 As Double, _
    ByVal X2 As Double, _
    ByVal Y2 As Double _
) As Rectangle

    With New Rectangle

        Set Create = .Self(X1, Y1, X2, Y2)

    End With

End Function

Public Function Self _
( _
    ByVal X1 As Double, _
    ByVal Y1 As Double, _
    ByVal X2 As Double, _
    ByVal Y2 As Double _
) As Rectangle

    With p

        .X1 = X1
        .Y1 = Y1
        .X2 = X2
        .Y2 = Y2
        ' extend this pattern to include any other parameters relevant to drawing your rectangle
    End With

    Set Self = Me

End Function


Public Sub Draw()   ' You don't want to provide parameters when you call draw.  This should be done
                    ' when you create your rectangle

' Put the code to draw the rectangle here

End Sub

Вы заметите, что мы включили функцию для рисования прямоугольника. Вы поймете, почему мы сделали это позже.

Теперь мы создаем страницы прямоугольников. Так в модуль входят

Public Function SetupPage1() As Collection
' In practise we would probably setup a Page class and register the rectangles with the page class instance
Dim my_rectangles As Collection

    Set my_rectangles = New Collection

    With my_rectangles
        .Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
        .Add Rectangle.Create(3.179133858, 1.181102362, 6.131889764, 1.57480315)
        ' etc

    End With

    Set SetupPage1 = my_rectangles

End Function

А

Public Function SetupAllPages() As Collection


Dim my_pages As Collection

   Set my_pages = New Collection

   With my_pages

        .Add SetupPage1
        .Add SetupPage2
        .Add SetupPage3
        'etc

    End With

    Set SetupAllPages = my_pages

End Function

И, наконец, в том же или другом модуле код для рисования прямоугольников на всех страницах.

Public Sub DrawPages()

Dim PagesToDraw         As Collection
Dim this_page           As Variant
Dim this_rectangle      As Variant

    Set PagesToDraw = SetupAllPages

    For Each this_page In PagesToDraw ' this page takes a collection

        For Each this_rectangle In this_page

            this_rectangle.Draw

        Next

    Next

End Sub

С помощью приведенного выше подпрограммы вы теперь можете понять, почему мы не хотим, чтобы наш Draw Sub принимал параметры, это означало бы, что мы потеряли простоту кода здесь.

Последний шаг - установить предварительно объявленный атрибут класса Rectangle. Вы можете сделать это, экспортировав класс в Notepad ++, установив для атрибута значение treu и повторно импортировав его. Или с помощью атрибута @PredeclaredId, предлагаемого надстройкой Fantabulous RubberDuck.

Возвращайтесь сюда, если вы застряли.

Приведенный выше код может быть улучшен, но я надеюсь, что теперь вы сможете увидеть путь вперед.

...