mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Пример программного управления надстройкой YandexMarket для поиска цен по разным регионам

В этой статье приведён пример кода для программного управления моими универсальными надстройками,
на примере надстройки для поиска цен в Яндекс.маркет

Sub FindPricesForAllSheets()
    On Error Resume Next: Err.Clear
    Const ADDIN_NAME$ = "YandexMarket"        ' задаем здесь кодовое имя надстройки

    Dim AddinFilename$, AddinPath$, msg$
    ' проверяем, запущена ли надстройка, пытаясь получить имя файла надстройки
    ' Функция с именем GetAddinFilename_КодовоеИмяНадстройки есть в каждой моей программе
    AddinFilename$ = Application.Run("GetAddinFilename_" & ADDIN_NAME$)
 
    If Err.Number = 1004 Then        ' функция GetAddinFilename_ не ответила - значит, надстройка не запущена

        ' считываем в реестре путь к файлу надстройки (он там есть, если программа хоть раз запускалась)
        AddinPath$ = GetSetting(ADDIN_NAME$, "Setup", "AddinPath", "")
 
        If AddinPath$ = "" Or Dir(AddinPath$, vbNormal) = "" Then
            ' если путь к надстройке в реестре не найден (надстройка не запускалась ранее)
            ' или путь найден, но уже недействителен (файл надстройки был удален)
            msg$ = "Надстройка «" & ADDIN_NAME$ & "» не найдена на этом компьютере." & vbNewLine & _
                   "Скачайте и запустите надстройку " & ADDIN_NAME$ & ", а потом заново запустите этот макрос." & _
                   vbNewLine & "Нажмите OK, чтобы открыть страницу программы на сайте ExcelVBA.ru"
            If MsgBox(msg, vbCritical + vbOKCancel, "Требуется запустить надстройку " & ADDIN_NAME$) = vbOK Then _
               CreateObject("wscript.shell").Run "http://excelvba.ru/programmes/" & ADDIN_NAME$
 
            Exit Sub        ' выход из макроса, т.к. продолжение работы без запущенной надстройки невозможно
        End If
 
        Workbooks.Open AddinPath$        ' пробуем открыть (запустить) надстройку

        ' и снова проверяем, запустила программа или нет
        Err.Clear: AddinFilename$ = Application.Run("GetAddinFilename_" & ADDIN_NAME$)
        If Err.Number = 1004 Then
            ' надстройка не запустилась, или какая-то другая проблема
            MsgBox "Не удалось запустить надстройку «" & ADDIN_NAME$ & "»" & vbNewLine & _
                   "Файл надстройки повреждён, или используется старая версия" & vbNewLine & _
                   "Обратитесь к автору макроса", vbCritical, "Проблема при запуске надстройки"
            Exit Sub        ' выход из макроса, т.к. продолжение работы без запущенной надстройки невозможно
        End If
    End If
 
 
    ' если надо проверить версию надстройки (обычно не требуется - можно удалить эти строки)
    Dim ver&: ver& = Application.Run("'" & AddinFilename$ & "'!GetVersion")
    If ver& < 2002 Then MsgBox "Требуется обновить надстройку", vbExclamation, "Продолжение невозможно": Exit Sub
 
 
    ' теперь мы точно знаем, что надстройка запущена, и готова к использованию
    ' программно меняем настройки (если надо)
    ' можно подгрузить набор настроек из файла XML (предварительно экспортировав настройки программы в этот файл)
    Dim SettingsFilename$: SettingsFilename$ = ThisWorkbook.Path & "\settings.xml"
    If Dir(SettingsFilename$, vbNormal) <> "" Then        ' если файл настроек найден в папке с текущим файлом Excel
        ' применяем настройки, вызывая макрос ImportSettings
        ' с двумя параметрами: SettingsFilename$ - путь к файлу настроек, и TRUE - для подавления вывода уведомления
        Dim res As Boolean: res = Application.Run("'" & AddinFilename$ & "'!ImportSettings", SettingsFilename$, True)
        ' If Not res Then Exit Sub        ' ошибка импорта настроек из найденного файла XML
    End If
 
    ' Все настройки программы сохранены в реестре по пути
    ' HKEY_CURRENT_USER \ Software \ VB and VBA Program Settings \ КодовоеИмяНадстройки \ Settings
    ' Можно менять настройки по одной, например:
    SaveSetting ADDIN_NAME$, "Settings", "SourceData_FirstRow", 2        ' номер первой строки с данными на листе
    SaveSetting ADDIN_NAME$, "Settings", "ComboBox_WP_Timeout", 6        ' таймаут запроса к сайту, 6 секунд
    SaveSetting ADDIN_NAME$, "Settings", "TextBox_ClearColumnsList", "3-100"        ' номера очищаемых столбцов
    ' (по аналогии, можно изменить любые другие настройк. названия доступных опций - можно помотреть в реестре)

 
    ' приступаем к использованию надстройки

    Dim sh As Worksheet, RegionName$, RegionCode&, ShopsCount&
    For Each sh In ThisWorkbook.Worksheets        ' перебираем все листы в книге

        ' берем название региона из имени очередного листа
        RegionName$ = Trim(sh.Name)
 
        ' определяем числовой код региона, вызывая функцию GetYandexRegionCode с параметром RegionName$
        RegionCode& = 0
        RegionCode& = Application.Run("'" & AddinFilename$ & "'!GetYandexRegionCode", RegionName$)
 
        If RegionCode& = 0 Then
            ' функция возвращает 0, если регион не распознан
            MsgBox "Не удалось распознать регион «" & RegionName$ & "»", vbExclamation, "Измените имя листа"
 
        Else
            ' регион распознан, - записываем код региона в настройки программы (сохраняем в реестре)
            SaveSetting ADDIN_NAME$, "Settings", "ComboBox_YandexRegion", RegionCode&
 
            ' активируем лист перед запуском поиска цен
            ThisWorkbook.Activate: sh.Activate
 
            ' определяем количество столбцов с названиями интернет-магазинов на текущем листе
            ShopsCount& = 0: ShopsCount& = sh.Range("c1:iv1").SpecialCells(xlCellTypeConstants).Count
            If ShopsCount& > 0 Then        ' если в указанном диапазоне найдены заполненные ячейки

                ' записываем количество блоков цен в настройки программы (сохраняем в реестре)
                SaveSetting ADDIN_NAME$, "Settings", "ComboBox_BlocksCount", ShopsCount&
 
                ' запускаем макрос очистки листа ClearSheet из надстройки
                Application.Run "'" & AddinFilename$ & "'!ClearSheet"
 
                ' запускаем основной макрос поиска цен StartYandexMarketSearch из надстройки
                Application.Run "'" & AddinFilename$ & "'!StartYandexMarketSearch"
 
                ' выход из макроса, если в процессе поиска цен, пользователь нажал кнопку ОТМЕНА
                If Application.Run("'" & AddinFilename$ & "'!YandexMarketSearchCancelled") = True Then Exit Sub
            End If
        End If
    Next sh
 
    MsgBox "Загрузка цен завершена", vbInformation, "Готово"
End Sub

Комментарии

Отправить комментарий

CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____  _              _           _____
|__ / / | _ __ __| | __ _ |__ /
/ / | | | '__| / _` | / _` | / /
/ /_ | | | | | (_| | | (_| | / /_
/____| |_| |_| \__,_| \__, | /____|
|___/
Введите код, изображенный в стиле ASCII-арт.