VBA 6.3

Версия реализации Visual Basic for Applications языка программирования Basic

Версия Visual Basic for Applications, встроенная в линейку продуктов Microsoft Office 2002.

Примеры:

Hello, World! - Basic (500):

Этот код создает макрос под названием “Hello”, выполнение которого выводит окно с сообщением “Hello, World!” и единственной кнопкой “OK”.

Sub Hello()
    MsgBox ("Hello, World!")
End Sub

Факториал вычисляется итеративно; значения накапливаются в строковой переменной и затем выводятся в одном окне. & — оператор конкатенации, CStr преобразует число в строку (несмотря на то, что факториал хранится как число с плавающей точкой, выводится он без дробной части), Chr возвращает символ с заданным ASCII-кодом.

Sub Factorial()
    Dim f As Double
    Dim res As String
    f = 1
    For i = 0 To 16
        res = res & CStr(i) & "! = " & CStr(f) & Chr(10)
        f = f * (i + 1)
    Next i
    MsgBox (res)
End Sub

Числа Фибоначчи - Basic (502):

Используется рекурсивное вычисление чисел Фибоначчи. Отметим, что в этом случае тип счетчика цикла i приходятся объявлять в явном виде, иначе он принимает тип Variant и не может быть передан в функцию вместо типа Integer.

Public Function Fibonacci(N As Integer) As Integer
  If N < 2 Then
    Fibonacci = N
  Else
    Fibonacci = Fibonacci(N - 1) + Fibonacci(N - 2)
  End If
End Function

Sub Fib()
  Dim res As String
  Dim i As Integer
  For i = 1 To 16
    res = res & CStr(Fibonacci(i)) & ", "
  Next i
  MsgBox (res & "...")
End Sub

CamelCase - Basic (503):

Sub CamelCase()
  Dim Text As String
  Text = LCase(Application.InputBox("Enter Text"))
  For i = 1 To Len(Text) Step 1
    If InStr("abcdefghijklmnopqrstuvwxyz", Mid(Text, i, 1)) = 0 Then
      Text = Replace(Text, Mid(Text, i, 1), " ")
    End If
  Next i
  MsgBox (Replace(StrConv(Text, vbProperCase), " ", ""))
End Sub

Квадратное уравнение - Basic (509):

Function GetInt(Name As String) As Integer
  Dim Coef As String
  Coef = Application.InputBox("Enter Coefficient " & Name)
  GetInt = CInt(Coef)
End Function

Sub Quadratic()
  Dim A As Integer, B As Integer, C As Integer, D As Integer
  A = GetInt("A")
  If A = 0 Then
    MsgBox ("Not a quadratic equation.")
    Exit Sub
  End If
  B = GetInt("B")
  C = GetInt("C")
  D = B * B - 4 * A * C
  Dim p1 As Double, p2 As Double
  p1 = -B / 2# / A
  p2 = Sqr(Abs(D)) / 2# / A
  If D = 0 Then
    MsgBox ("x = " & CStr(p1))
  Else
    If D > 0 Then
      MsgBox ("x1 = " & CStr(p1 + p2) & Chr(10) & "x2 = " & CStr(p1 - p2))
    Else
      MsgBox ("x1 = (" & CStr(p1) & ", " & CStr(p2) & ")" & Chr(10) & "x2 = (" & CStr(p1) & ", " & CStr(-p2) & ")")
    End If
  End If
End Sub