Автоматизация в Excel Сервис->Поиск решения

[djozzz]

Привет! Такой вопрос: Надо в Еxcel автоматизировать функцию "Поиск решения". Я нашел каким образом проверить установлен ли он и каким образом можно задавать параметры (узнал через запись макроса и последующий поиск решения). Теперь не могу понять каким образом можно с макроса запустить этот Поиск Решения. При запуске макроса выдаёт следующее - Не определена функция или процедура. Если создать объект через ADDIn (позволяющий проверить  установлен ли он - нашел в хелпе мелкософта) и через точку прописать эти самые процедуры, то пишет что объект не имеет таких свойств или методов. Кто знает как это делается, помогите! 

[djozzz]

Приветик всем!
Мне хотелось бы несколько конкретизировать свой вопрос:
проверить установлен ли "Поиск решения" можно следующим образом:

If AddIns("Поиск решения").Installed = False Then AddIns("Поиск решения").Installed = True

задавать параметры можно так (из макроса):

    SolverOk SetCell:="$E$4", MaxMinVal:=3, ValueOf:="0", ByChange:="$G$7:$G$9"
    SolverAdd CellRef:="$G$7", Relation:=1, FormulaText:="$G$8"
    SolverAdd CellRef:="$G$8", Relation:=3, FormulaText:="$G$9"
    SolverSolve

именно в данном случае выдаётся ошибка - Не определена функция или процедура

Я взломал спомощью AVPR пароль и экпортировал тексты всех макроссов из библиотеки мелкософта в свой файл. Параметры передаются, но макросы вылетают с непонятной ошибкой.
Попытка вызвать макросы напрямую с надстройки мелкософта (SOLVER), тоже не получилась, т.к. параметры функций в данном случае вообще не передаются (возникает ошибка с передачей параметров типа "Переменная:=значение").
Может кто знает как передать параметры именно таким способом (в макросах мелкософта анализируются параметры именно по участку "Переменная:=").

Кто хочет подробне обсудить данный вопрос - добро пожаловать в ICQ, хотя логичнее было бы здесь.

[HandKot]

выложите свой файл
будет время покапаюсь

[djozzz]

to HandKot

сюда _ftp://82.179.20.33/incoming/solver
или сюда _ftp://82.179.20.33/incoming/solver2

[djozzz]

Да, чуть не забыл.. Конечный вариант данного кода не должен нарушать прав мелкософта, т.к. данная работа будет использована в дипломной работе.

[HandKot]

Ну Вы почти все сделали, только не довели до конца
Вот мой вариант и прав ничьих вроде не нарушает

Код:

Sub MySolver()
    Dim wbSolv As Workbook
    
    'подключаем "Поиск решений"
    On Error Resume Next
    Set wbSolv = Workbooks("Solver.xla")
    
    On Error GoTo EH
    If wbSolv Is Nothing Then
        Set wbSolv = Workbooks.Open(ThisWorkbook.Path & "\Solver.xla")
    End If

    'Инициализируем
    Application.Run "Solver.xla!Auto_Open"
    Application.Run "Solver.xla!SolverReset"
    
    'Данные для расчета
    Application.Run "Solver.xla!SolverOk", "$E$4", 3, 0, "$G$7:$G$9"
    Application.Run "Solver.xla!SolverAdd", "$G$7", 1, "$G$8"
    'Application.Run "Solver.xla!SolverAdd", "$G$8", 3, "$G$9"
    Application.Run "Solver.xla!SolverSolve"
    
    Exit Sub
EH:
    MsgBox Err.Source & "~" & Err.Description
End Sub

Пробуйте

[djozzz]

А можно как-нибудь в Excel узнать папку в которой он установлен? (для того, чтобы не носить с собой Solver.xla, а запускать его с папки самого офиса)

[djozzz]

Я доделал то, что спрашивал. Конечный код выглядит так:

Sub MySolver()
    'Dim wbSolv As Workbook
   
    'подключаем "Поиск решений"
    'On Error Resume Next
    'Set wbSolv = Workbooks("Solver.xla")
   
    'On Error GoTo EH
    'If wbSolv Is Nothing Then
    '    Set wbSolv = Workbooks.Open(ThisWorkbook.Path & "\Solver.xla")
    'End If
   
    If AddIns("Поиск решения").Installed = False Then AddIns("Поиск решения").Installed = True

    'Инициализируем
    Application.Run "Solver.xla!Auto_Open"
    Application.Run "Solver.xla!SolverReset"
   
    'Данные для расчета
    Application.Run "Solver.xla!SolverOk", "'[solver__book.xls]Лист1'!$E$4", 3, 279, "'[solver__book.xls]Лист1'!$G$7:$G$9"
    Application.Run "Solver.xla!SolverAdd", "'[solver__book.xls]Лист1'!$G$7", 1, "'[solver__book.xls]Лист1'!$G$8"
    Application.Run "Solver.xla!SolverAdd", "'[solver__book.xls]Лист1'!$G$8", 3, "'[solver__book.xls]Лист1'!$G$9"
    Application.Run "Solver.xla!SolverSolve", True
    'Application.Run "Solver.xla!SolverSave", "'[solver__book.xls]Лист1'!$A$1"
   
    Exit Sub
EH:
    MsgBox Err.Source & "~" & Err.Description
End Sub

Спасибо за помощь.

[djozzz]

Хотя этот код как-то странно работает... На одной машине работает, а на другой пишет, что целевая ячейка должна быть единственной, но при пошаговом выполнении всё ОК.

А вместо строки:

If AddIns("Поиск решения").Installed = False Then AddIns("Поиск решения").Installed = True

надо написать:

AddIns("Поиск решения").Installed = False
AddIns("Поиск решения").Installed = True

Странно.. Может дело в каких-нибудь настройках???

[djozzz]

Этот код работает нормально (тьфу-тьфу):

Sub MySolver()
    Dim wbSolv As Workbook
    
    'подключаем "Поиск решений"
    On Error Resume Next
    Set wbSolv = Workbooks("Solver.xla")
    
    On Error GoTo EH
    If wbSolv Is Nothing Then
        Set wbSolv = Workbooks.Open(AddIns("Поиск решения").FullName)
    End If
  
    'Инициализируем
    Application.Run "Solver.xla!Auto_Open"
    Application.Run "Solver.xla!SolverReset"
    
    'Данные для расчета
    'pth = "'[" + ThisWorkbook.Name + "]" + ThisWorkbook.ActiveSheet.Name + "'!"
        
    Application.Run "Solver.xla!SolverOk", "'[Solver_book.xls]Лист1'!$E$4", 3, 279, "'[Solver_book.xls]Лист1'!$G$7:$G$9"
    Application.Run "Solver.xla!SolverAdd", "'[Solver_book.xls]Лист1'!$G$7", 1, "'[Solver_book.xls]Лист1'!$G$8"
    Application.Run "Solver.xla!SolverAdd", "'[Solver_book.xls]Лист1'!$G$8", 3, "'[Solver_book.xls]Лист1'!$G$9"
    Application.Run "Solver.xla!SolverSolve", True
    Application.Run "Solver.xla!SolverSave", "'[Solver_book.xls]Лист1'!$A$1"
    
    Exit Sub
EH:
    MsgBox Err.Source & "~" & Err.Description

End Sub