Гость
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Отлов всех MsgBox в коде / 25 сообщений из 30, страница 1 из 2
14.09.2016, 22:17
    #39309332
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Пишу функцию отлова всех сообщений в коде форм.
Но она ловит не более 5 штук.
Что в ней не верно написано?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
Public Function MESSAGI_GDE()
' ËÎÂÈÌ ÌÅÑÑÀÃÈ
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim s As String               ' Ñòðîêè áóêâû
    Dim i As Long                 ' Ñòðîêè øòóêè
    Dim N As Integer              ' ÍÀ×ÀËÎ ÑÒÐÎÊÈ
    Dim K As Integer              ' ÍÀ×ÀËÎ ÑÒÐÎÊÈ
    Dim m As Module
    Dim mi As Byte
    
    Set VBProj = Access.VBE.ActiveVBProject
For mi = 0 To Application.Modules.Count - 1
    Set m = Application.Modules(mi)
    Set VBComp = VBProj.VBComponents(m)
    Set CodeMod = VBComp.CodeModule
           For i = 2 To CodeMod.CountOfLines
                If InStr(1, CodeMod.Lines(i, 1), "MsgBox", vbTextCompare) <> 0 And InStr(1, CodeMod.Lines(i, 1), "InStr", vbTextCompare) = 0 Then
                    N = InStr(1, CodeMod.Lines(i, 1), "MsgBox", vbTextCompare) + 8
                    K = InStr(N, CodeMod.Lines(i, 1), """", vbTextCompare) - N
                    s = ""
                    s = Mid(CodeMod.Lines(i, 1), N, K)
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL "INSERT INTO LANGUAGE_TBL (RUS) VALUES ('" & s & "')"
                    DoCmd.SetWarnings True
                End If
           Next i
Next mi
    Set VBProj = Nothing
    Set m = Nothing
    Set VBComp = Nothing
    Set CodeMod = Nothing
End Function


--------------------------------------------------------------------------
СПС
...
Рейтинг: 0 / 0
14.09.2016, 23:08
    #39309341
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,

Заменил строку For mi = 0 To Application.Modules.Count - 1
на
For mi = 0 To CurrentProject.AllModules.Count - 1

модулей стало обрабатываться поболее
было 4 стало 10.
но всё равно ловит только 7 месаг
...
Рейтинг: 0 / 0
14.09.2016, 23:15
    #39309343
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
А потрассировать?
...
Рейтинг: 0 / 0
14.09.2016, 23:16
    #39309344
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Akina,

Простите....
что сделать?
...
Рейтинг: 0 / 0
14.09.2016, 23:22
    #39309349
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Трассировка кода... поставь на первой исполняемой строке (которая Set VBProj = Access.VBE.ActiveVBProject) брейкпойнт (F9) и, когда выполнение остановится, выполняй по одной строке кода (F8), наблюдая за значениями переменных (View - Locals Window).
...
Рейтинг: 0 / 0
14.09.2016, 23:35
    #39309352
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Akina,

это я делал.
Всё пучком отрабатывает, записывает.
но только модули проекта, а не модули форм.
вот где собака....
...
Рейтинг: 0 / 0
15.09.2016, 09:45
    #39309460
Панург
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58, пример, строку сам разбирай
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Sub tt_Modules()
Dim lngSLine As Long, lngSCol As Long, lngOldSLine As Long
Dim lngELine As Long, lngECol As Long
Dim i As Long
Dim strLine As String

    With Application.Modules
        For i = 0 To .Count - 1
            With .Item(i)
                lngOldSLine = 0
                    Do While .Find("MsgBox", lngSLine, lngSCol, lngELine, lngECol)
                            If lngOldSLine >= lngSLine Then Exit Do
                        strLine = .Lines(lngSLine, Abs(lngELine - lngSLine) + 1)'<-вот строка, её и разбирай
                        Debug.Print Mid(strLine, lngSCol, lngECol - lngSCol), .Name
                        
                        lngOldSLine = lngSLine
                        lngSLine = lngELine
                        lngSCol = lngECol
                    Loop
            End With
        Next i
    End With
End Sub
...
Рейтинг: 0 / 0
15.09.2016, 09:50
    #39309461
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Панург,

Большое спасибо.
...
Рейтинг: 0 / 0
15.09.2016, 09:56
    #39309467
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Панург,
Единственное что смущает, это то, что
Application.Modules "видит" только 4 модуля проекта, хотя их 10 штук.
не говоря уже о более десятка форм с сидящими в них модулями.
...
Рейтинг: 0 / 0
15.09.2016, 10:03
    #39309472
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,
Вот если написать вот так - With Application.CodeProject.AllForms
будет поболее модулей шерстить.
уже 33 штуки выходит.
...
Рейтинг: 0 / 0
15.09.2016, 10:13
    #39309478
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,
это формы.
А тебе нужны модули этих форм.
...
Рейтинг: 0 / 0
15.09.2016, 10:28
    #39309483
vmag
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,

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

Или их очень много? Типа:
- Вы точно хотите удалить эту запись?
- Вы точно-точно хотите удалить эту запись?
- Я последний раз спрашиваю - точно-точно-точно?
...
Рейтинг: 0 / 0
15.09.2016, 10:56
    #39309505
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
vmag,
Мне надо переводить фразы с одного языка на другой.
Надо собрать фразы в таблицу.
Фразы пополняются регулярно.
Хочу автоматизировать процесс.
...
Рейтинг: 0 / 0
15.09.2016, 10:58
    #39309506
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,

Попробуй вот эту функцию.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
Public Function MESSAGI_OTLOV()
' отлов всех мессаг
Dim i As Long
Dim mi As Long
Dim strLine As String
On Error Resume Next
        For i = 0 To Application.CodeProject.AllForms.Count
           For mi = 2 To Len(Application.Modules(i).Lines(1, Application.Modules(i).CountOfLines))
                If InStr(1, Application.Modules(i).Lines(mi, 1), "MsgBox", vbTextCompare) <> 0 And InStr(1, Application.Modules(i).Lines(mi, 1), "InStr", vbTextCompare) = 0 Then
                    N = InStr(1, Application.Modules(i).Lines(mi, 1), "MsgBox", vbTextCompare) + 8
                    K = InStr(N, Application.Modules(i).Lines(mi, 1), """", vbTextCompare) - N
                    strLine = ""
                    If K > N Then
                        strLine = Mid(Application.Modules(i).Lines(mi, 1), N, K)
                        DoCmd.SetWarnings False
                          DoCmd.RunSQL "INSERT INTO LANGUAGE_TBL (RUS) VALUES ('" & strLine & "')"
                        DoCmd.SetWarnings True
                    End If
                End If
           Next mi
          Next i
MsgBox i
End Function
...
Рейтинг: 0 / 0
15.09.2016, 10:58
    #39309507
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58,

Спасибо, уже лучшее.
...
Рейтинг: 0 / 0
15.09.2016, 11:15
    #39309527
MrShin
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Могу предложить вариант вообще без программирования. Ставим MZ-Tools, запускаем поиск, сохраняем результаты в текстовый файл и извращаемся с ним как захотим.
...
Рейтинг: 0 / 0
15.09.2016, 11:24
    #39309538
ROI
ROI
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58vmag,
Мне надо переводить фразы с одного языка на другой.
Надо собрать фразы в таблицу.
Фразы пополняются регулярно.
Хочу автоматизировать процесс.
А каких фраз например?
Чёт я не догоняю.
Если сообшения об ошибках, то для этого есть объект Error.
С уважением.
...
Рейтинг: 0 / 0
15.09.2016, 11:39
    #39309553
vmag
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
ROIЕсли сообшения об ошибках, то для этого есть объект Error.

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

а тема автора актуальная - расширяет рынок сбыта ПО, но я б всё равно делал руками за один заход:
- таблица фраз (колонки 3-4 думаю будет достаточно: ID, RUS, EN,....)
- общая функция сообщения с параметрами
- нашел по контексту первое сообщение, вбил в таблицу RUS + сразу EN, переделал сразу на функцию
- нашел следующее, и так в цикле...

После первого прохода будет уже два языка ID фразы общий, а по номеру столбца язык,
потом переводи в третий столбец на испанский и уже три языка...
...
Рейтинг: 0 / 0
15.09.2016, 12:00
    #39309571
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
MrShin,
эту процедуру буду делать не я, потому нужно автоматизировать процесс.
...
Рейтинг: 0 / 0
15.09.2016, 12:04
    #39309574
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
ROI,
Фразы типа:
"ВЫХОД ИЗ ПРОГРАММЫ?"

If MsgBox("ВЫХОД ИЗ ПРОГРАММЫ?", vbYesNo + vbInformation, Mid(CurrentProject.Name, 1, Len(CurrentProject.Name) - 6)) = vbYes Then DoCmd.Quit
...
Рейтинг: 0 / 0
15.09.2016, 12:05
    #39309578
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
vmag,
эту процедуру буду делать не только я, потому нужно автоматизировать процесс.
...
Рейтинг: 0 / 0
15.09.2016, 12:24
    #39309592
Панург
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
час58, всё мучаешься? Вот, потестируй, накидал тут...
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
Sub tt_Modules2()
Dim lngSCol As Long, lngECol As Long
Dim i As Long, j As Long
Dim strLine As String

Const csMSG As String = "MsgBox"

    With Application.Modules
        For i = 0 To .Count - 1
            With .Item(i)
    Debug.Print i, .Name
                For j = 1 To .CountOfLines
                    strLine = .Lines(j, 1)
                    lngSCol = InStr(1, strLine, csMSG, vbBinaryCompare)
                        If lngSCol > 0 Then
                                Do Until Not Right$(strLine, 3) = "& _" 'выясним не было ли переноса строки, можешь под свой код поправить...
                                    j = j + 1
                                    strLine = Left$(strLine, Len(strLine) - 3) & .Lines(j, 1)
                                Loop
                            lngECol = InStr(lngSCol, strLine, ",")'другие параметры функции
                                If lngECol = 0 Then lngECol = InStr(lngSCol, strLine, ":")'продолжили в той же строке
                                If lngECol = 0 Then
                                    strLine = Mid(strLine, lngSCol + Len(csMSG))
                                Else
                                    strLine = Trim(Mid(strLine, lngSCol + Len(csMSG), lngECol - (lngSCol + Len(csMSG))))
                                End If
                            strLine = Replace(Replace(Replace(strLine, vbCrLf, " "), "   ", " "), "  ", " ")
                            Debug.Print strLine
                        End If
                Next j
            End With
        Next i
    End With
End Sub
...
Рейтинг: 0 / 0
15.09.2016, 12:32
    #39309608
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Панург,

Спасибо.
...
Рейтинг: 0 / 0
15.09.2016, 12:33
    #39309609
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Панург,
Вопросами мучают, а код - только от тебя поступает.
...
Рейтинг: 0 / 0
15.09.2016, 13:23
    #39309648
час58
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Отлов всех MsgBox в коде
Панург,
вот тут
Код: vbnet
1.
For I = 0 To .Count - 1


= 4 шт

Обработал две формы и два модуля и вышел из цикла.
Всё чисто
без ошибок.
...
Рейтинг: 0 / 0
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / Отлов всех MsgBox в коде / 25 сообщений из 30, страница 1 из 2
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]