Удаление комментариев в коде

@aleks_des · Регистрация: 20.01.2015

Author24 — интернет-сервис помощи студентам

Добрый вечер! Может кто знает как быстро из кода VBA удалить все комментарии, а то у меня комментарии размером почти как сам код, очень утяжеляет рабочий код.

@Казанский · 26.10.2015, 18:18

aleks_des, http://www.vbaexpress.com/kb/g... ?kb_id=266
Вообще, много комментариев - это замечательно!

А на работу кода наличие комментариев не влияет, только на размер файла.

@aleks_des · 26.10.2015, 18:33 **[ТС]**

Ок спасибо, у меня просто простой вордовский файл почти мегабайт весит, нужно объем уменьшить

shanemac51 · 26.10.2015, 19:15

вряд ли это код ---скорей туда супер-рисунок закинули или очень много формул/рисунков

@aleks_des · 26.10.2015, 19:27 **[ТС]**

Он действительно не работает,
Во-первых написан для Excel, мне нужно для Word (моя вина, не уточнил) попытался переписать для word, не нашел фразу аналог в word

Visual Basic

1	If Quotes = Application.WorksheetFunction.Odd(Quotes) Then

Во-вторых этот код даже в Excel не работает

@pashulka · 26.10.2015, 20:44

VBA Code Cleaner

P.S. Обратите внимание на то, что здесь также не удаляются комментарии, созданные с помощью инструкции REM

@aleks_des · 26.10.2015, 20:48 **[ТС]**

это вы про что?

@pashulka · 26.10.2015, 21:10

Пардон, полное название утилиты Excel VBA Code Cleaner, так что можете не обращать внимание на мой пост

Аксима · 26.10.2015, 23:25

Здравствуйте, aleks_des,

Весьма любопытная задача. Набросал свой дилетантский (наверное), зато кроссплатформенный (в том смысле, что он работает в любых приложениях, использующих VBA) вариант макроса удаления комментариев... Может быть, он вас заинтересует.

Программа удаления комментариев из кода VBA

Visual Basic

Type CursorPos
    Ln As Long
    Col As Long
End Type
 
Sub DeleteRemarks()
    Dim quot As String, apos As String, remPattern As String
    Dim env As Object, prj As Object, com As Object, cmd As Object
    Dim docName As String, lineCount As Long, lastLineCharCount As Long
    Dim cursorStart As CursorPos, cursorEnd As CursorPos
    Dim remFound As Boolean, remLine As String, beforeRem As String
    Dim i As Long, n As Long, quotCount As Long, ch As String * 1
    quot = Chr(34): apos = Chr(39): remPattern = apos & Chr(42)
    Set env = Application.VBE
    docName = env.MainWindow.Caption
    On Error Resume Next
    docName = Split(docName, "-")(1)
    On Error GoTo 0
    docName = Trim(Replace(docName, "[running]", ""))
    Set prj = env.ActiveVBProject
    If MsgBox("Сейчас будут удалены все комментарии в программных модулях проекта " & prj.Name & " (документ " & docName & "). Вы уверены?", vbYesNo + vbDefaultButton2, "Необратимая операция (предупреждение)") = vbYes Then
    For Each com In prj.VBComponents
        Set cmd = com.CodeModule
        lineCount = cmd.CountOfLines
        lastLineCharCount = Len(cmd.Lines(lineCount, 1))
        cursorStart.Ln = 1
        cursorStart.Col = 1
        cursorEnd.Ln = lineCount
        cursorEnd.Col = lastLineCharCount + 1
        remFound = cmd.Find(remPattern, cursorStart.Ln, cursorStart.Col, cursorEnd.Ln, cursorEnd.Col, , , True)
        While remFound
            remLine = cmd.Lines(cursorStart.Ln, 1)
            n = Len(remLine)
            beforeRem = Space(n)
            quotCount = 0
            For i = 1 To n
                ch = Mid(remLine, i, 1)
                If ch = apos Then
                    If quotCount Mod 2 = 0 Then Exit For Else Mid(beforeRem, i, 1) = apos
                ElseIf ch = quot Then
                    Mid(beforeRem, i, 1) = quot
                    quotCount = quotCount + 1
                Else
                    Mid(beforeRem, i, 1) = ch
                End If
            Next i
            If i <= n Then
                If Len(Trim(beforeRem)) = 0 Then
                    cmd.DeleteLines cursorStart.Ln, 1
                    cursorStart.Ln = cursorStart.Ln - 1
                Else
                    cmd.ReplaceLine cursorStart.Ln, RTrim(beforeRem)
                End If
            End If
            cursorStart.Ln = cursorStart.Ln + 1
            cursorStart.Col = 1
            cursorEnd.Ln = lineCount
            cursorEnd.Col = lastLineCharCount + 1
            remFound = cmd.Find(remPattern, cursorStart.Ln, cursorStart.Col, cursorEnd.Ln, cursorEnd.Col, , , True)
        Wend
    Next com
    End If
End Sub

С уважением,

Аксима

@aleks_des · 27.10.2015, 10:23 **[ТС]**

Все четко! Спасибо. На работу дилетанта не похоже, как минимум нужно знание структуры VBA.

А комментариев нет, удалились УдаляторомКомментариев?

Аксима · 27.10.2015, 12:19

Здравствуйте, aleks_des,

Если я правильно понял, что вас интересуют также пояснения к программе, то предлагаю вашему вниманию...

Комментарии к коду программы "УдаляторКомментариев".

Введение

Назначение программы "УдаляторКомментариев" - удаление комментариев из кода VBA. Для ускорения работы и повышения надежности (неизвестно, как поведет себя программа при модификации самой себя) она не содержит комментариев. Этот пробел восполняется далее.

Комментарии

Visual Basic
1 2 3 4
Type CursorPos Ln As Long Col As Long End Type
Тип CursorPos разработан для описания позиции курсора в IDE. Приняты те же сокращения, что в самой IDE: Ln - сокращение от Line и означает номер строки программного кода, Col - сокращение от Column и означает номер столбца (вертикальной линии, разделяющей символы). Самая первая линия находится перед самым первым символом и имеет номер 1.

Visual Basic

Dim quot As String, apos As String, remPattern As String
Dim env As Object, prj As Object, com As Object, cmd As Object
Dim docName As String, lineCount As Long, lastLineCharCount As Long
Dim cursorStart As CursorPos, cursorEnd As CursorPos
Dim remFound As Boolean, remLine As String, beforeRem As String
Dim i As Long, n As Long, quotCount As Long, ch As String * 1

quot - Переменная для хранения символа "Двойная кавычка" (").
apos - Переменная для хранения символа "Апостроф" (').
remPattern - Переменная, хранящая шаблон для первичного поиска комментариев.
env, prj, com, cmd - Переменные, относящиеся к объектной модели IDE.
docName - Переменная для хранения имени документа, программный проект которого подлежит очистке.
lineCount - Переменная для хранения количества строк кода в программном модуле.
lastLineCharCount - Переменная для хранения количества символов в последней строке кода.
cursorStart, cursorEnd - Переменные для хранения границ выделения, в котором осуществляется поиск комментария.
remFound - Флаг, указывающий на то, что была найдена строка, похожая на комментарий.
remLine - Текст строки, похожей на комментарий.
beforeRem - Текст части строки, находящейся перед комментарием.
i, n - Переменные цикла.
quotCount - Счётчик количества двойных кавычек. Необходим для того, чтобы определить, находится ли символ апострофа внутри строки или является началом комментария.
ch - Переменная для хранения отдельного символа анализируемой строки.

Visual Basic
1
Set env = Application.VBE
Получаем ссылку на объект, предоставляющий доступ к среде разработчика.
Visual Basic
1 2 3 4 5
docName = env.MainWindow.Caption On Error Resume Next docName = Split(docName, "-")(1) On Error GoTo 0 docName = Trim(Replace(docName, "[running]", ""))
Получаем заголовок основного окна среды разработчика, который обычно имеет вид "Microsoft Visual Basic for Applications - <имя документа> [<статус выполнения макроса>] [ - <имя активного модуля>]".
Из заголовка выделяем имя книги ввместе со статусом и удаляем статус выполнения макроса (пользователя он не интересует).
Visual Basic
1
Set prj = env.ActiveVBProject
Получаем ссылку на активный проект.

Visual Basic

If MsgBox("Сейчас будут удалены все комментарии в программных модулях проекта " & prj.Name & " (документ " & docName & "). Вы уверены?", vbYesNo + vbDefaultButton2, "Необратимая операция (предупреждение)") = vbYes Then

Запрашиваем подтверждение операции по удалению макросов. Комментарии перед удалением не запоминаются, поэтому восстановить их будет невозможно.

Visual Basic
1 2
For Each com In prj.VBComponents Set cmd = com.CodeModule
Обрабатываем все программные модули проекта.

Visual Basic

lineCount = cmd.CountOfLines
lastLineCharCount = Len(cmd.Lines(lineCount, 1))
cursorStart.Ln = 1
cursorStart.Col = 1
cursorEnd.Ln = lineCount
cursorEnd.Col = lastLineCharCount + 1

Получаем максимально раннюю и максимально позднюю позиции курсора. Сформированное с их помощью выделение - это выделение всего кода в программном модуле.

Visual Basic
1
remFound = cmd.Find(remPattern, cursorStart.Ln, cursorStart.Col, cursorEnd.Ln, cursorEnd.Col, , , True)
Ищем строку, похожую на комментарий. Используем шаблон "'*", а не "'", чтобы каждая строка находилась только один раз (например, с шаблоном "'" строка MsgBox("'Hello'") будет обработана дважды (т.к. будут найден сначала первый, а потом второй апостроф). С шаблоном "'*" будет найдена подстрока 'Hello'"), а затем поиск продолжится уже в других строках.

Visual Basic

While remFound
    remLine = cmd.Lines(cursorStart.Ln, 1)
    n = Len(remLine)
    beforeRem = Space(n)
    quotCount = 0
    For i = 1 To n
        ch = Mid(remLine, i, 1)
        If ch = apos Then
                If quotCount Mod 2 = 0 Then Exit For Else Mid(beforeRem, i, 1) = apos
        ElseIf ch = quot Then
            Mid(beforeRem, i, 1) = quot
            quotCount = quotCount + 1
        Else
            Mid(beforeRem, i, 1) = ch
        End If
    Next i

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

Visual Basic

            If i <= n Then
                If Len(Trim(beforeRem)) = 0 Then
                    cmd.DeleteLines cursorStart.Ln, 1
                    cursorStart.Ln = cursorStart.Ln - 1
                Else
                    cmd.ReplaceLine cursorStart.Ln, RTrim(beforeRem)
                End If
            End If

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

Visual Basic

cursorStart.Ln = cursorStart.Ln + 1
cursorStart.Col = 1
cursorEnd.Ln = lineCount
cursorEnd.Col = lastLineCharCount + 1
remFound = cmd.Find(remPattern, cursorStart.Ln, cursorStart.Col, cursorEnd.Ln, cursorEnd.Col, , , True)

Выделяем код со следующей строки и до конца модуля и повторяем поиск строк, похожих на комментарии, до тех пор, пока таковые находятся.

Visual Basic
1
Next com
После очистки всех комментариев в программном модуле переходим к следующему модулю (если есть).

Резюме

Программа не идеальна, и наверняка можно было бы сделать ее лучше. В частности, вполне вероятно, что при более близком знакомстве с объектной моделью VBIDE окажется, что существует более простой (при сохранении кроссплатфоменности) метод получения имени содержащего проект документа. Также следует признать, что не исчерпаны все возможности по оптимизации быстродействия программы. Но даже в таком виде программа вполне работоспособна и способна более-менее эффективно выполнять свою основную задачу.

С уважением,

Аксима

@~~Апострофф~~ · 27.10.2015, 12:36

Visual Basic

1
2
3

'комментарий _
это тоже комментарий(но данная строка не удалена Удалятором, в полученном коде будет ошибка)
Rem И этот комментарий не удалён

@aleks_des · 27.10.2015, 23:24 **[ТС]**

Аксима благодарю за подробнейший комментарий. На этом примере попробую немного изучить структуру VBA

@Sasha_Smirnov · 28.10.2015, 04:15

Припомнив тему dimonser’а Подсветка синтаксиса в word 2007 — попробовал использовать зелёный цвет этих самых комментариев.

Но так глубоко не забурился, однако нашёл шаблон поиска* прямо в коде:
_________________
* не считая упомянутых Апострофф’ом многострочных комментов

Аксима · 19.11.2015, 17:33

После многих проб и ошибок сумел реализовать вариант программы, учитывающий ценные замечания от Апостроффа. В этом мне очень помогла теория конечных автоматов.

Программа удаления комментариев из кода VBA (улучшенная версия)

Visual Basic

Enum Status 'Состояния детерминированного конечного автомата, осуществляющего поиск комментариев в тексте.
    INITIAL 'Начальное.
    SPACE_FOUND 'Обнаружены хвостовые пробелы в начале линии.
    QUOT_FOUND 'Обнаружена открывающая кавычка строкового литерала. Поиск комментария в литерале не производится.
    REMARK_FOUND 'Обнаружен комментарий.
    R_FOUND 'Подозрение на 1-ю букву ключевого слова Rem.
    RE_FOUND 'Подозрение на 2 буквы ключевого слова Rem.
    REM_FOUND 'Подозрение на 3 буквы ключевого слова Rem.
    AFTERSPACE 'Текст после хвостовых пробелов (не строковой литерал и не комментарий).
    CR_FOUND 'Найден перевод строки.
    REMSPACE_FOUND 'Найден пробел внутри комментария (если за пробелом следует знак подчеркивания - это признак многострочного комментария).
    UNDERLINE_FOUND 'Найден знак подчеркивания после пробела (перевод строки больше не означает конец комментария).
End Enum
Rem Процедура удаления комментариев из кода VBA.
Sub DeleteRemarks()
    Dim env As Object, prj As Object, com As Object, cm As Object
    Dim i As Long, j As Long, k As Long, lc As Long, sc As Long, n As Long
    Dim doc As String, code() As Byte, clean() As Byte
    Dim s As Status, skipLine As Boolean
    Set env = Application.VBE
    Set prj = env.ActiveVBProject
    doc = "несохраненный"
    On Error Resume Next
    doc = prj.Filename
    On Error GoTo 0
    'Уточняем у пользователя, действительно ли он хочет удалить все комментарии.
    If MsgBox("Сейчас будут удалены все комментарии в программных модулях проекта " & prj.Name & " (документ " & doc & "). Вы уверены?", vbYesNo + vbDefaultButton2, "Необратимая операция (предупреждение)") = vbYes Then
        For Each com In prj.VBComponents
            Set cm = com.CodeModule
            lc = cm.CountOfLines
            If lc Then 'Если есть строки для анализа...
                code = cm.Lines(1, lc)
                n = UBound(code)
                ReDim clean(0 To n) As Byte
                s = INITIAL 'Устанавливаем автомат в начальное состояние.
                sc = 0
                k = 0
                skipLine = False
                For i = 0 To n Step 2
                    Select Case s
                        Case INITIAL
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        s = SPACE_FOUND
                                        sc = 1
                                    Case 34
                                        s = QUOT_FOUND
                                    Case 39
                                        s = REMARK_FOUND
                                        skipLine = True
                                    Case 82
                                        s = R_FOUND
                                    Case Else
                                        s = AFTERSPACE
                                End Select
                            End If
                        Case SPACE_FOUND
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        sc = sc + 1
                                    Case 39
                                        s = REMARK_FOUND
                                        skipLine = True
                                    Case 82
                                        s = R_FOUND
                                    Case Else
                                        For j = 1 To sc
                                            clean(k) = 32
                                            clean(k + 1) = 0
                                            k = k + 2
                                        Next j
                                        If code(i) = 34 Then s = QUOT_FOUND Else s = AFTERSPACE
                                End Select
                            End If
                        Case R_FOUND
                            If code(i) = 101 And code(i + 1) = 0 Then
                                s = RE_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    clean(k + 1) = 0
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                clean(k + 1) = 0
                                k = k + 2
                                If code(i) = 13 And code(i + 1) = 0 Then s = CR_FOUND Else s = AFTERSPACE
                            End If
                        Case RE_FOUND
                            If code(i) = 109 And code(i + 1) = 0 Then
                                s = REM_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    clean(k + 1) = 0
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                clean(k + 1) = 0
                                k = k + 2
                                clean(k) = 101
                                clean(k + 1) = 0
                                k = k + 2
                                If code(i) = 13 And code(i + 1) = 0 Then s = CR_FOUND Else s = AFTERSPACE
                            End If
                        Case REM_FOUND
                            If code(i + 1) = 0 And (code(i) = 13 Or code(i) = 32) Then
                                skipLine = True
                                If code(i) = 13 Then s = CR_FOUND Else s = REMARK_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    clean(k + 1) = 0
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                clean(k + 1) = 0
                                k = k + 2
                                clean(k) = 101
                                clean(k + 1) = 0
                                k = k + 2
                                clean(k) = 109
                                clean(k + 1) = 0
                                k = k + 2
                                s = AFTERSPACE
                            End If
                        Case AFTERSPACE
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 34
                                        s = QUOT_FOUND
                                    Case 39
                                        s = REMARK_FOUND
                                End Select
                            End If
                        Case REMARK_FOUND
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        s = REMSPACE_FOUND
                                End Select
                            End If
                        Case QUOT_FOUND
                            If code(i) = 34 And code(i + 1) = 0 Then s = AFTERSPACE
                        Case CR_FOUND
                            'Если в абзаце(ах) исходника нет ничего, кроме комментария (о чем сигнализирует _
                            булева переменная skipLine), то в выходной текст абзац не добавляем.
                            If skipLine Then
                                skipLine = False
                            Else
                                clean(k) = 13
                                k = k + 2
                                clean(k) = 10
                                k = k + 2
                            End If
                            s = INITIAL
                        Case REMSPACE_FOUND
                            If code(i) = 95 And code(i + 1) = 0 Then s = UNDERLINE_FOUND Else s = REMARK_FOUND
                        Case UNDERLINE_FOUND
                            s = REMARK_FOUND
                    End Select
                    If s = QUOT_FOUND Or s = AFTERSPACE Then
                        clean(k) = code(i)
                        clean(k + 1) = code(i + 1)
                        k = k + 2
                    End If
                Next i
                If k < n Then
                    cm.DeleteLines 1, lc
                    cm.AddFromString CStr(clean)
                End If
            End If
        Next com
        MsgBox "Все комментарии удалены", vbInformation, "Результат"
    Else
        MsgBox "Удаление комментариев отменено.", vbInformation, "Результат"
    End If
End Sub

Была также мысль реализовать поиск комментариев через регулярные выражения, но производительность недетерминированных конечных автоматов (на которые отображаются регулярные выражения) ниже, чем производительность детерминированных конечных автоматов, что для больших объемов текста весьма существенно. Текущий вариант сочетает надежность с высокой производительностью.

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

С уважением,

Аксима

@aleks_des · 19.11.2015, 20:24 **[ТС]**

Не корректно работает. Попробуйте на примере:

Visual Basic

Private Function Ячейки(Optional n As Integer)
    If txt_Ячейки.Value <> "" Then
        If txt_Ячейки.Value Like "* *" Or txt_Ячейки.Value Like "*,*" Then
            Ячейки = IIf(n = 1, " (", "") & IIf(n = 2, ", ", "") & "ячейки " & txt_Ячейки.Value & IIf(n = 1, ")", "")
        Else
            Ячейки = IIf(n = 1, " (", "") & IIf(n = 2, ", ", "") & "ячейка " & txt_Ячейки.Value & IIf(n = 1, ")", "")
        End If
    End If
End Function
 
Private Sub cmd_Печать_Click()
On Error GoTo Ошибка
    Dim sPrinter As String ' переменная имени активного принтера
    sPrinter = ActivePrinter ' присваиваем имя активный принтера
    ' Принтер по умолчанию на время работы приложения
    ActivePrinter = Work_Form.txt_Принтер.Value ' Присваивает имя принтера из поля "Принтер по умолчанию" в настройках
    ' Печать по параметрам: Количество копий, Сортирова по копиям (False)
    ActiveDocument.PrintOut Copies:=txt_Копии.Value, Collate:=ch_Сортировка.Value
    Application.ActivePrinter = sPrinter ' возвращает активный принтер на момент открытия документа
    Exit Sub
Ошибка:
    Dim mBox As VbMsgBoxResult
    mBox = MsgBox("      Заданный принтер" & vbCrLf & _
           Work_Form.txt_Принтер.Value & vbCrLf & _
           "не найден. Задать принтер?", vbYesNo + vbExclamation, "Ошибка принтера")
    If mBox = vbYes Then cmd_Принтер_Click
End Sub

Добавлено через 21 минуту
Кстати, это удаление комментариев можно вернуть кнопкой отмена

Аксима · 19.11.2015, 21:30

aleks_des, действительно, упустил ряд переходов в автомате... С этими автоматами надо быть очень аккуратным и внимательным.

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

Программа удаления комментариев из кода VBA (улучшенная и скорректированная версия)

Visual Basic

Enum Status 'Состояния детерминированного конечного автомата, осуществляющего поиск комментариев в тексте.
    INITIAL 'Начальное.
    SPACE_FOUND 'Обнаружены хвостовые пробелы в начале линии.
    QUOT_FOUND 'Обнаружена открывающая кавычка строкового литерала. Поиск комментария в литерале не производится.
    REMARK_FOUND 'Обнаружен комментарий.
    R_FOUND 'Подозрение на 1-ю букву ключевого слова Rem.
    RE_FOUND 'Подозрение на 2 буквы ключевого слова Rem.
    REM_FOUND 'Подозрение на 3 буквы ключевого слова Rem.
    AFTERSPACE 'Текст после хвостовых пробелов (не строковой литерал и не комментарий).
    CR_FOUND 'Найден перевод строки.
    REMSPACE_FOUND 'Найден пробел внутри комментария (если за пробелом следует знак подчеркивания - это признак многострочного комментария).
    UNDERLINE_FOUND 'Найден знак подчеркивания после пробела (перевод строки больше не означает конец комментария).
End Enum
Rem Процедура удаления комментариев из кода VBA.
Sub DeleteRemarks()
    Dim env As Object, prj As Object, com As Object, cm As Object
    Dim i As Long, j As Long, k As Long, lc As Long, sc As Long, n As Long
    Dim doc As String, code() As Byte, clean() As Byte
    Dim s As Status, skipLine As Boolean
    Set env = Application.VBE
    Set prj = env.ActiveVBProject
    doc = "несохраненный"
    On Error Resume Next
    doc = prj.Filename
    On Error GoTo 0
    'Уточняем у пользователя, действительно ли он хочет удалить все комментарии.
    If MsgBox("Сейчас будут удалены все комментарии в программных модулях проекта " & prj.Name & " (документ " & doc & "). Вы уверены?", vbYesNo + vbDefaultButton2, "Необратимая операция (предупреждение)") = vbYes Then
        For Each com In prj.VBComponents
            Set cm = com.CodeModule
            lc = cm.CountOfLines
            If lc Then 'Если есть строки для анализа...
                code = cm.Lines(1, lc)
                n = UBound(code)
                ReDim clean(0 To n) As Byte
                s = INITIAL 'Устанавливаем автомат в начальное состояние.
                sc = 0
                k = 0
                skipLine = False
                For i = 0 To n Step 2
                    Select Case s
                        Case INITIAL
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        s = SPACE_FOUND
                                        sc = 1
                                    Case 34
                                        s = QUOT_FOUND
                                    Case 39
                                        s = REMARK_FOUND
                                        skipLine = True
                                    Case 82
                                        s = R_FOUND
                                    Case Else
                                        s = AFTERSPACE
                                End Select
                            Else
                                s = AFTERSPACE
                            End If
                        Case SPACE_FOUND
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        sc = sc + 1
                                    Case 39
                                        s = REMARK_FOUND
                                        skipLine = True
                                    Case 82
                                        s = R_FOUND
                                    Case Else
                                        For j = 1 To sc
                                            clean(k) = 32
                                            k = k + 2
                                        Next j
                                        If code(i) = 34 Then s = QUOT_FOUND Else s = AFTERSPACE
                                End Select
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    k = k + 2
                                Next j
                                s = AFTERSPACE
                            End If
                        Case R_FOUND
                            If code(i) = 101 And code(i + 1) = 0 Then
                                s = RE_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                k = k + 2
                                If code(i) = 13 And code(i + 1) = 0 Then s = CR_FOUND Else s = AFTERSPACE
                            End If
                        Case RE_FOUND
                            If code(i) = 109 And code(i + 1) = 0 Then
                                s = REM_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                k = k + 2
                                clean(k) = 101
                                k = k + 2
                                If code(i) = 13 And code(i + 1) = 0 Then s = CR_FOUND Else s = AFTERSPACE
                            End If
                        Case REM_FOUND
                            If code(i + 1) = 0 And (code(i) = 13 Or code(i) = 32) Then
                                skipLine = True
                                If code(i) = 13 Then s = CR_FOUND Else s = REMARK_FOUND
                            Else
                                For j = 1 To sc
                                    clean(k) = 32
                                    k = k + 2
                                Next j
                                clean(k) = 82
                                k = k + 2
                                clean(k) = 101
                                k = k + 2
                                clean(k) = 109
                                k = k + 2
                                s = AFTERSPACE
                            End If
                        Case AFTERSPACE
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 34
                                        s = QUOT_FOUND
                                    Case 39
                                        s = REMARK_FOUND
                                End Select
                            End If
                        Case REMARK_FOUND
                            If code(i + 1) = 0 Then
                                Select Case code(i)
                                    Case 13
                                        s = CR_FOUND
                                    Case 32
                                        s = REMSPACE_FOUND
                                End Select
                            End If
                        Case QUOT_FOUND
                            If code(i) = 34 And code(i + 1) = 0 Then s = AFTERSPACE
                        Case CR_FOUND
                            'Если в абзаце(ах) исходника нет ничего, кроме комментария (о чем сигнализирует _
                            булева переменная skipLine), то в выходной текст абзац не добавляем.
                            If skipLine Then
                                skipLine = False
                            Else
                                clean(k) = 13
                                k = k + 2
                                clean(k) = 10
                                k = k + 2
                            End If
                            s = INITIAL
                        Case REMSPACE_FOUND
                            If code(i) = 95 And code(i + 1) = 0 Then s = UNDERLINE_FOUND Else s = REMARK_FOUND
                        Case UNDERLINE_FOUND
                            s = REMARK_FOUND
                    End Select
                    If s = QUOT_FOUND Or s = AFTERSPACE Then
                        clean(k) = code(i)
                        clean(k + 1) = code(i + 1)
                        k = k + 2
                    End If
                Next i
                If k < n Then
                    cm.DeleteLines 1, lc
                    cm.AddFromString CStr(clean)
                End If
            End If
        Next com
        MsgBox "Все комментарии удалены", vbInformation, "Результат"
    Else
        MsgBox "Удаление комментариев отменено.", vbInformation, "Результат"
    End If
End Sub

С уважением,

Аксима

@Sasha_Smirnov 5562 / 1368 / 150 Регистрация: 08.02.2009 Сообщений: 4,109 Записей в блоге: 30
	28.10.2015, 04:15	14
	Припомнив тему dimonser’а Подсветка синтаксиса в word 2007 — попробовал использовать зелёный цвет этих самых комментариев. Но так глубоко не забурился, однако нашёл шаблон поиска* прямо в коде: _________________ * не считая упомянутых Апострофф’ом многострочных комментов Миниатюры 0

Удаление комментариев в коде

Решение

Решение

Решение

@aleks_des 194 / 13 / 3 Регистрация: 20.01.2015 Сообщений: 174
		1
	Удаление комментариев в коде 26.10.2015, 17:16. Показов 4371. Ответов 16 Метки нет (Все метки) Добрый вечер! Может кто знает как быстро из кода VBA удалить все комментарии, а то у меня комментарии размером почти как сам код, очень утяжеляет рабочий код. 0

@Казанский 15145 / 6418 / 1731 Регистрация: 24.09.2011 Сообщений: 9,999
	26.10.2015, 18:18	2
	Сообщение было отмечено Памирыч как решение Решение aleks_des, http://www.vbaexpress.com/kb/g... ?kb_id=266 Вообще, много комментариев - это замечательно! А на работу кода наличие комментариев не влияет, только на размер файла. 1

@aleks_des 194 / 13 / 3 Регистрация: 20.01.2015 Сообщений: 174
	26.10.2015, 18:33 [ТС]	3
	Ок спасибо, у меня просто простой вордовский файл почти мегабайт весит, нужно объем уменьшить 0

shanemac51 Модератор 11960 / 4828 / 779 Регистрация: 07.08.2010 Сообщений: 14,138 Записей в блоге: 4
	26.10.2015, 19:15	4
	вряд ли это код ---скорей туда супер-рисунок закинули или очень много формул/рисунков 0

@pashulka 4134 / 2238 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	26.10.2015, 20:44	6
	VBA Code Cleaner P.S. Обратите внимание на то, что здесь также не удаляются комментарии, созданные с помощью инструкции REM 0

@aleks_des 194 / 13 / 3 Регистрация: 20.01.2015 Сообщений: 174
	26.10.2015, 20:48 [ТС]	7
	это вы про что? 0

@pashulka 4134 / 2238 / 940 Регистрация: 01.12.2010 Сообщений: 4,624
	26.10.2015, 21:10	8
	Пардон, полное название утилиты Excel VBA Code Cleaner, так что можете не обращать внимание на мой пост 0

@aleks_des 194 / 13 / 3 Регистрация: 20.01.2015 Сообщений: 174
	27.10.2015, 10:23 [ТС]	10
	Все четко! Спасибо. На работу дилетанта не похоже, как минимум нужно знание структуры VBA. А комментариев нет, удалились УдаляторомКомментариев? 0

@aleks_des 194 / 13 / 3 Регистрация: 20.01.2015 Сообщений: 174
	27.10.2015, 23:24 [ТС]	13
	Аксима благодарю за подробнейший комментарий. На этом примере попробую немного изучить структуру VBA 0