McConst
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Здравствуйте.
Делаю программу, которая в перспективе должна будет проверять объявления в интернете, и если найдет удовлетворяющие поиску объявления, останавливается.
Предполагаю, что поиск будет выполняться в неактивном окне Excel, и при появлении результата, окно Excel должно раскрываться на весь экран поверх всех остальных окон. Проверку активности/неактивности окна и его раскрытие реализовал через API функции в процедуре house
Проблема вот в чем, окно максимизируется, но остается на заднем плане. Ексель начинает мигать. Но мне-то надо, чтобы он появлялся на переднем плане. Вставил в код минимизацию активного окна. Тоже не работает. В переменную RES возвращается код ошибки 0 (см. последние строки процедуры). Не пойму почему функция не работает так, как указано в описании. Прикладываю файл. Кнопка запуска макроса в левом верхнем углу.
API задекларированы в модуле API, константы API прописаны там же. Код процедуры house приведен ниже, а файл с работающим каркасом проекта здесь http://yadi.sk/d/aocSyKi36wvva
Public Sub house()
'Поиск в интернете свежих объявлений о сдаче квартир с отсеиванием объявлений агентств
'по черному телефонному списку
'
'
'
Dim i As Integer, j As Integer 'счетчики в циклах
Dim lastRow As Integer ' последняя строчка на листе с объявлениями (конец объединенной строки)
'Переменные для работы с API
Dim Res As Long 'Результат выполнения функции
Dim HandleAW As Long 'Описатель активного окна
Dim hwnd As Long ' Описатель приложения Excel
ActiveWindow.ScrollRow = 10
UserForm1.ListBox1.Clear
'Инициализация черного и серого списка телефонов
If Worksheets("Объявления").CheckBox2 Then
PhoneBlackListReading
If Worksheets("Объявления").CheckBox3 Then
'Корректируем черный список согласно исключениям серого списка
PhoneGrayListReading
NewBlackList Count:=PhoneBlackListCount, BlackList:=PhoneBlackList
End If
End If
'Построчная инициализация массива старых объявлений
lastRow = Worksheets("Все объявления").Cells(Rows.Count, 1).End(xlUp).Row
OldFlatCount = 0
For i = StartRow To lastRow Step 3
OldFlatCount = OldFlatCount + 1
OldFlat(OldFlatCount) = ReadRow(i)
Next i
'Определяем, активно ли окно Excel. Получаем Handle активного окна
HandleAW = GetActiveWindow
'Загрузка списка новых объявлений из интернета
If Application.hwnd <> HandleAW Then
'Если поиск начался при свёрнутом или неактивном окне
Worksheets("Объявления").Label12.Caption = "Идет поиск в скрытом режиме"
UnactiveWindow = True
UserForm1.TutBY
Else
'Поиск при развернутом окне
UnactiveWindow = False
UserForm1.Show
End If
'Отсеивание объявлений согласно поисковому запросу
Elimination
Application.ScreenUpdating = False
'Сохраняем скачаные списки объявлений на вкладку "Все объявления"
SaveNewAdvertisment
'Выводим на лист "Объявления" новые объявления
ShowNewAdvertisment
Application.ScreenUpdating = True
'Проверяем, активно ли окно перед завершением операции
HandleAW = GetActiveWindow
hwnd = Application.hwnd
If (hwnd <> HandleAW) Then '(VisibleFlatCount > 0) And
'Если окно неактивно и найдено новое объявление, окно раскрывается на весь экран
Worksheets("Объявления").Label12.Visible = False
Worksheets("Объявления").Buttons(1).Caption = "Начать отслеживание"
Worksheets("Объявления").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False
Res = ShowWindow(HandleAW, SW_SHOWMINIMIZED)
Res = ShowWindow(hwnd, SW_SHOWMAXIMIZED)
Res = SetForegroundWindow(hwnd)
DoEvents
End
End If
End Sub |
