Public Function Test(a As Long) As Long
'пример функции
If a >  0  Then
Test =  1 
Else
Test =  0 
End If
End Function

[SIZE= 2 ][color=blue]Public Function[/color] Test(a [color=blue]As Long[/color]) [color=blue]As Long[/color]
[color=green]'пример функции[/color]
[color=blue]If[/color] a >  0  [color=blue]Then[/color]
Test =  1 
[color=blue]Else[/color]
Test =  0 
[color=blue]End If[/color]
[color=blue]End Function[/color][/SIZE]

'Процедура форматирования кода
'Для использования - создать новый проект и на форму добавить кнопку Command1
'Для проверки работоспособности - скопировать любой код и нажать Command1
'В буфере обмена будет размеченный код, готовый для вставки в ваше сообщение на форуме
'Предлагаю поучаствовать в дальнейшем развитии этого проекта
Option Explicit
Private Sub Command1_Click()
    Dim aStr(0 To 199) As String 'массив искомых слов
    Dim mStrIn As String 'входящая строка
    Dim mStrInLen As Long 'длина входящей строки
    Dim mStrOut As String 'выходящая строка
    Dim mStrSub As String 'выделенная подстрока
    Dim mChr As String 'выделенный символ
    Dim mNum As Long 'текущая позиция
    Dim mNumOld As Long 'предыдущая позиция
    Dim bOk As Boolean 'признак обнаружения подстроки
    Dim i As Byte 'счётчик
    Dim arr1 As Variant
    Dim arr2 As Variant
    'массив ключевых слов
    arr1 = Array("#If", "#End", "#ElseIf", "#Else", "#Const", "Xor", "Write", _
       "WithEvents", "With", "Width", "While", "Wend", "Variant", _
       "Until", "Unknown", "Unlock", "Unload", "UBound", "TypeOf", _
       "Type", "True", "To", "Then", "Text", "Tab", "Sub", "String$", _
       "String", "StrComp", "Stop", "Step", "Static", "Spc", "Single", _
       "Shared", "Sgn", "Set", "Select", "Seek", "Scale", "RSet", _
       "RGB", "Return", "Resume", "Rem", "ReDim", "Read", "Randomize", _
       "Random", "RaiseEvent", "Put", "Public", "PSet", "Property", _
       "Private", "Print", "Preserve", "ParamArray", "Output", "Or", _
       "Optional", "Option", "Open", "On", "Object", "Null", "Nothing", _
       "Not", "Next", "New", "Name", "Module", "Mod", "MidB$", "MidB", _
       "Mid$", "Mid", "Me", "LSet", "Loop", "Long", "Lock", "Local", _
       "Load", "LINEINPUT", "Line", "Like", "Lib", "Let", "LenB", "Len", _
       "Left", "LBound", "Is", "Integer", "Int", "InStrB", "InStr", _
       "InputB$", "InputB", "Input$", "Input", "In", "Implements", _
       "Imp", "If", "GoTo", "GoSub", "Go", "Global", "Get", "Function", _
       "Friend", "FreeFile", "Format$", "Format", "For", "Fix", "False", _
       "F", "Explicit", "Exit", "Event", "Error$", "Error", "Erase", _
       "Eqv", "Enum", "EndIf", "End", "Empty", "ElseIf", "Else", "Each", _
       "Double", "DoEvents", "Do", "Dir$", "Dir", "Dim", "DefVar", "DefStr", _
       "DefSng", "DefObj", "DefLng", "DefInt", "DefDbl", "DefDec", "DefDate", _
       "DefCur", "DefByte", "DefBool", "Declare", "Decimal", "Debug", "Date$", _
       "Date", "Database", "Currency", "CVErr", "CVDate", "CVar", "CurDir$", _
       "CurDir", "CStr", "CSng", "Const", "Compare", "Close", "CLng", "Circle", _
       "CInt", "ChDir", "CDecl", "CDbl", "CDec", "CDate", "CCur", "CByte")
    'ограничение на размер массива, определяемого таким способом
    arr2 = Array("CBool", "Case", "Call", "ByVal", "Byte", "ByRef", "Boolean", _
       "Binary", "BF", "Base", "B", "Assert", "As", "Array", "Append", "Any", _
       "And", "Alias", "AddressOf", "Access", "Abs")

    For i = 0 To 178
        aStr(i) = arr1(i)
    Next
    For i = 0 To 20
        aStr(179 + i) = arr2(i)
    Next

    mStrIn = Clipboard.GetText & vbCr 'получили строку из буфера
    mNumOld = 0
    mStrOut = "[" & "FIXED" & "]"
    mStrOut = mStrOut & "[" & "SIZE=2" & "]"
    
    mStrInLen = Len(mStrIn)
    For mNum = 1 To mStrInLen 'перечисляем все символы входящей строки
        mChr = Mid$(mStrIn, mNum, 1) 'выделяем символ

        If mChr = " " Or mChr = vbCr Or mChr = vbLf Or mChr = "(" Or mChr = ")" _
           Or mChr = "," Or mNum = Len(mStrIn) Then
            If mChr = " " Then mChr = "&nb" & "sp;"
            'обнаружен разделитель слов
            mStrSub = Mid$(mStrIn, mNumOld + 1, mNum - mNumOld - 1) 'выделяем подстроку
            bOk = False

            For i = 0 To 199 'поиск подстроки
                If mStrSub = aStr(i) Then
                    bOk = True
                    Exit For
                End If
            Next

            If bOk = True Then 'подстрока найдена
                mStrOut = mStrOut & "[" & "color=blue" & "]" & mStrSub & _
                                    "[" & "/color" & "]" & mChr
            Else
                mStrOut = mStrOut & mStrSub & mChr
            End If

            mNumOld = mNum
        End If

        If mChr = Chr$(39) Then 'обнаружен коментарий
            mNum = InStr(mNum, mStrIn, vbCrLf)
            If mNum = 0 Then mNum = Len(mStrIn)
            mStrSub = Mid$(mStrIn, mNumOld + 1, mNum - mNumOld - 1) 'выделяем подстроку
            mStrOut = mStrOut & "[" & "color=green" & "]" & mStrSub & _
                                "[" & "/color" & "]"
            mNumOld = mNum
        End If
    Next

    mStrOut = mStrOut & "[" & "/SIZE" & "]"
    mStrOut = mStrOut & "[" & "/FIXED" & "]"
    Clipboard.SetText mStrOut 'вернули строку в буфер
    MsgBox "Код скопирован в буфер"
End Sub

    \\\'Для использования - создать новый проект VB или VBA    \\\'                  - поместить в код формы ниже лежащий текст программы    \\\'                  - скопировать любой код и запустить программу (открыть форму)    \\\'В буфере обмена будет размеченный код, готовый для вставки в ваше сообщение на форуме    \\\'Предлагаю поучаствовать в дальнейшем развитии этого проекта    Option Explicit        Private Declare Function OpenClipboard _                    Lib "user32" (ByVal hWnd As Long) As Long    Private Declare Function CloseClipboard _                    Lib "user32" () As Long    Private Declare Function GetClipboardData _                    Lib "user32" (ByVal wFormat As Long) As Long    Private Declare Function GlobalAlloc _                    Lib "kernel32" (ByVal wFlags&, _                                    ByVal dwBytes As Long) As Long    Private Declare Function GlobalLock _                    Lib "kernel32" (ByVal hMem As Long) As Long    Private Declare Function GlobalUnlock _                    Lib "kernel32" (ByVal hMem As Long) As Long    Private Declare Function lstrlen _                    Lib "kernel32" _                    Alias "lstrlenA" (ByVal lpString As Long) As Long    Private Declare Sub CopyMemory _                    Lib "kernel32" _                    Alias "RtlMoveMemory" (pDst As Any, _                                           pSrc As Long, _                                           ByVal ByteLen As Long)        Private Declare Function lstrcpy _                    Lib "kernel32" (ByVal lpString1 As Any, _                                    ByVal lpString2 As Any) As Long    Private Declare Function EmptyClipboard _                    Lib "user32" () As Long    Private Declare Function SetClipboardData _                    Lib "user32" (ByVal wFormat As Long, _                                  ByVal hMem As Long) As Long        Private Declare Function GetKeyboardLayoutName _                    Lib "user32" _                    Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long    Private Declare Function LoadKeyboardLayout _                    Lib "user32" _                    Alias "LoadKeyboardLayoutA" (ByVal HKL As String, _                                                 ByVal Flags As Long) As Long    Private Const KL_NAMELENGTH = 9    Private Const GHND = &H42    Private Const CF_TEXT = 1Public Sub Form_Load()    \\\'Процедура форматирования кода        Dim aStr(0 To 199) As String \\\'массив искомых слов    Dim mStrIn As String \\\'входящая строка    Dim mStrInLen As Long \\\'длина входящей строки    Dim mStrOut As String \\\'выходящая строка    Dim mStrSub As String \\\'выделенная подстрока    Dim mChr As String \\\'выделенный символ    Dim mNum As Long \\\'текущая позиция    Dim mNumOld As Long \\\'предыдущая позиция    Dim bOk As Boolean \\\'признак обнаружения подстроки    Dim i As Byte \\\'счётчик    Dim arr1 As Variant    Dim arr2 As Variant                    \\\'массив ключевых слов    arr1 = Array("#If", "#End", "#ElseIf", "#Else", "#Const", "Xor", "Write", _       "WithEvents", "With", "Width", "While", "Wend", "Variant", _       "Until", "Unknown", "Unlock", "Unload", "UBound", "TypeOf", _       "Type", "True", "To", "Then", "Text", "Tab", "Sub", "String$", _       "String", "StrComp", "Stop", "Step", "Static", "Spc", "Single", _       "Shared", "Sgn", "Set", "Select", "Seek", "Scale", "RSet", _       "RGB", "Return", "Resume", "Rem", "ReDim", "Read", "Randomize", _       "Random", "RaiseEvent", "Put", "Public", "PSet", "Property", _       "Private", "Print", "Preserve", "ParamArray", "Output", "Or", _       "Optional", "Option", "Open", "On", "Object", "Null", "Nothing", _       "Not", "Next", "New", "Name", "Module", "Mod", "MidB$", "MidB", _       "Mid$", "Mid", "Me", "LSet", "Loop", "Long", "Lock", "Local", _       "Load", "LINEINPUT", "Line", "Like", "Lib", "Let", "LenB", "Len", _       "Left", "LBound", "Is", "Integer", "Int", "InStrB", "InStr", _       "InputB$", "InputB", "Input$", "Input", "In", "Implements", _       "Imp", "If", "GoTo", "GoSub", "Go", "Global", "Get", "Function", _       "Friend", "FreeFile", "Format$", "Format", "For", "Fix", "False", _       "F", "Explicit", "Exit", "Event", "Error$", "Error", "Erase", _       "Eqv", "Enum", "EndIf", "End", "Empty", "ElseIf", "Else", "Each", _       "Double", "DoEvents", "Do", "Dir$", "Dir", "Dim", "DefVar", "DefStr", _       "DefSng", "DefObj", "DefLng", "DefInt", "DefDbl", "DefDec", "DefDate", _       "DefCur", "DefByte", "DefBool", "Declare", "Decimal", "Debug", "Date$", _       "Date", "Database", "Currency", "CVErr", "CVDate", "CVar", "CurDir$", _       "CurDir", "CStr", "CSng", "Const", "Compare", "Close", "CLng", "Circle", _       "CInt", "ChDir", "CDecl", "CDbl", "CDec", "CDate", "CCur", "CByte")    \\\'ограничение на размер массива, определяемого таким способом    arr2 = Array("CBool", "Case", "Call", "ByVal", "Byte", "ByRef", "Boolean", _       "Binary", "BF", "Base", "B", "Assert", "As", "Array", "Append", "Any", _       "And", "Alias", "AddressOf", "Access", "Abs")    For i = 0 To 178        aStr(i) = arr1(i)    Next    For i = 0 To 20        aStr(179 + i) = arr2(i)    Next     mStrIn = ClipBoard_GetData & vbCr \\\'получили строку из буфера    mNumOld = 0    mStrOut = "[" & "FIXED" & "]"    mStrOut = mStrOut & "[" & "SIZE=2" & "]"    mStrInLen = Len(mStrIn)    For mNum = 1 To mStrInLen \\\'перечисляем все символы входящей строки        mChr = Mid$(mStrIn, mNum, 1) \\\'выделяем символ        If mChr = " " Or mChr = vbCr Or mChr = vbLf Or mChr = "(" Or mChr = ")" _           Or mChr = "," Or mNum = Len(mStrIn) Then            If mChr = " " Then mChr = "&nb" & "sp;"            \\\'обнаружен разделитель слов            mStrSub = Mid$(mStrIn, mNumOld + 1, mNum - mNumOld - 1) \\\'выделяем подстроку            bOk = False            For i = 0 To 199 \\\'поиск подстроки                If mStrSub = aStr(i) Then                    bOk = True                    Exit For                End If            Next                        If bOk = True Then \\\'подстрока найдена                mStrOut = mStrOut & "[" & "color=blue" & "]" & mStrSub & _                                    "[" & "/color" & "]" & mChr            Else                mStrOut = mStrOut & mStrSub & mChr            End If            mNumOld = mNum        End If        If mChr = Chr$(39) Then \\\'обнаружен коментарий            mNum = InStr(mNum, mStrIn, vbCrLf)            If mNum = 0 Then mNum = Len(mStrIn)            mStrSub = Mid$(mStrIn, mNumOld + 1, mNum - mNumOld - 1) \\\'выделяем подстроку            mStrOut = mStrOut & "[" & "color=green" & "]" & mStrSub & _                                "[" & "/color" & "]"            mNumOld = mNum - 1        End If        If mChr = vbLf And Right$(mStrOut, 2) = vbCrLf Then            mStrOut = Left$(mStrOut, Len(mStrOut) - 2)            mStrOut = mStrOut & "" & "13"        End If    Next    mStrOut = mStrOut & "" & "13"    mStrOut = mStrOut & "[" & "/SIZE" & "]"    mStrOut = mStrOut & "[" & "/FIXED" & "]"    \\\'ссылка на эту процедуру    mStrOut = mStrOut & "[" & "SIZE=1" & "]"    mStrOut = mStrOut & "[" & "url=http://"    mStrOut = mStrOut & "/topic/87621" & "]"    mStrOut = mStrOut & "Как отформатирован этот код?" & "[" & "/url" & "]"    mStrOut = mStrOut & "[" & "/SIZE" & "]"    ClipBoard_SetData (mStrOut) \\\'вернули строку в буфер    MsgBox "Код скопирован в буфер"End Sub\\\'vba не имеет класса Сlipboard\\\'ниже приведены функции найденные на\\\'http://am.rusimport.ru/MsAccess/topic.aspx?ID=229\\\'и модифицированные мнойPrivate Function ClipBoard_GetData() As String    Dim hClipMemory As Long    Dim lpClipMemory As Long    Dim MyString As String    Dim lLength As Long    Dim RetVal As Long        If OpenClipboard(0&) = 0 Then        MsgBox "Невозможно открыть буфер обмена, " & "Может быть он занят другим приложением"        Exit Function    End If    \\\' получить указатель на блок памяти, с текстом буфера обмена    hClipMemory = GetClipboardData(CF_TEXT)    If IsNull(hClipMemory) Then        MsgBox "Невозможно выделить память"        GoTo OutOfHere    End If             \\\' фиксируем блок памяти, чтобы получить указатель на строку    lpClipMemory = GlobalLock(hClipMemory)    lLength = lstrlen(lpClipMemory)    If Not IsNull(lpClipMemory) Then        MyString = Space$(lLength)        CopyMemory ByVal MyString, ByVal lpClipMemory, lLength        RetVal = GlobalUnlock(hClipMemory)    Else        MsgBox "невозможно фиксировать блок памяти"    End IfOutOfHere:    RetVal = CloseClipboard()    ClipBoard_GetData = MyStringEnd FunctionPrivate Sub ClipBoard_SetData(MyString As String)    Dim hGlobalMemory As Long    Dim lpGlobalMemory As Long    Dim lLength As Long    Dim hClipMemory As Long    Dim x As Long    \\\'Выделяем блок памяти    lLength = Len(MyString)    hGlobalMemory = GlobalAlloc(GHND, lLength + 1)    \\\'Фиксируем блок памяти, чтобы получить указатель    lpGlobalMemory = GlobalLock(hGlobalMemory)    \\\'Копируем строку в этот блок памяти    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)    \\\'Снимаем фиксацию блока памяти    If GlobalUnlock(hGlobalMemory) <> 0 Then        MsgBox "Невозможно снять фиксацию блока память. Копирование прервано."        GoTo OutOfHere2    End If    \\\'Открываем буфер обмена для копирования    If OpenClipboard(0&) = 0 Then        MsgBox "Невозможно открыть буфер обмена. Копирование прервано."        Exit Sub    End If    \\\'Очистка буфера обмена    x = EmptyClipboard()    \\\'переключаемся на русскую раскладку чтобы не иметь    \\\'проблем с русским текстом в буфере    \\\'(некорректно понимается кодовая страница)    Dim sOldLang As String    sOldLang = switchLang("00000419")    \\\'Копируем данные в буфер обмена    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)OutOfHere2:    If CloseClipboard() = 0 Then        MsgBox "Невозможно закрыть буфер обмена."    End If    \\\'возвращаем раскладку на место    If Len(sOldLang) > 0 Then sOldLang = switchLang(sOldLang)End Sub        Private Function getCurrLang() As String    Dim layoutname As String * KL_NAMELENGTH    Dim z As Long    z = GetKeyboardLayoutName(layoutname)    If z = 0 Then        getCurrLang = ""    Else        getCurrLang = StrZ(layoutname)    End IfEnd Function\\\'Переключает на указанную sNewLang раскладку - возвращает старую раскладкуPrivate Function switchLang(sNewLang As String) As String    \\\'"00000419" - русская    \\\'"00000409" - латинская    switchLang = getCurrLang    If StrComp(switchLang, sNewLang) <> 0 Then        LoadKeyboardLayout sNewLang, 1    End IfEnd FunctionPrivate Function StrZ(par As String) As String    Dim nSize As Long, i As Long    nSize = Len(par)    i = InStr(1, par, Chr$(0)) - 1    If i > nSize Then i = nSize    If i < 0 Then i = nSize    StrZ = Mid$(par, 1, i)End Function