Версия для печати темы

Автор: Azrael 1:01:2007, 17:41

Каммент модера
Отличная тема но необходима редакция так как:
1. Приведите привер ,напишите плз, функцию заполнения какимито значениями , для наглядности(просто выдрать кусок кода не стоит, это только запутает человека ). В идеале опишите задачу, решение и приведённый код станет понятен )))
2. Допишите хотя-бы примитивный обработчик ошибок
3. Вы уверены что в Англ. версии надстройка называеться "Поиск решения" ?

'Определяем International Word'a
If ExcWin.Application.International( 1 ) = 1 Then 'English
        ....
Elseif  ExcWin.Application.International(  1  ) = 7 Then ' Rus
        ...
End If

4. Не вводите в заблуждение людей, здесь Вы использете именно оле-технологии(CreateObject) и напрямую(не всё то OLE что VBA)


Поиск решения в MS Excel - неплохая надстройка, но вот чтобы запустить ее из другого приложения - приходится несколько извратиться, поскольку эта надстройка не является созданием Microsoft'а - создана сторонними разработчиками, поэтому не получается напрямую использовать OLE-технологии (т.е. создать руками макрос и посмотреть код, созданный Excel (работать не будет!)
Делюсь частью кода непосредственно для вызова и настройки поиска решения:

        ' создание файла MS Excel
    Set ms=CreateObject("Excel.Application")
    On Error Resume Next
    Call ms.Workbooks.Add()
    If Err<>0 Then
        Msgbox "Не удалось создать файл MS Excel !",16,stTitle
        Err=0
        Goto ErrLabel
    End If
    On Error Goto ErrLabel
    
    ms.ReferenceStyle=-4150 ' стиль ссылок "R1C1"
    
    ' переход на первый лист
    Set sheet=ms.ActiveWorkbook.Worksheets(1)
    sheet.Activate

    ' надстройка "Поиск решения"
    Set SolverAddIn=ms.AddIns("Поиск решения")
    
    ' книга Solver.xla
    Set wb=ms.Workbooks.Open(SolverAddIn.FullName)
    Call ms.Run("Solver.xla!Auto_Open")
    
    ' Задание целевой ячейки и изменяемых ячеек
    Call ms.Run("Solver.xla!SolverOk", sheet.Cells(numRowTotals,2), 2, 0, sheet.Range(sheet.Cells(numRowK,2),sheet.Cells(numRowK+Ubound(arr)-1,2)) )
    
    ' Задание ограничений
    ' ограничения на кол-во комплектов: целое, неотрицательное число
    Call ms.Run("Solver.xla!SolverAdd", sheet.Range(sheet.Cells(numRowK,2),sheet.Cells(numRowK+Ubound(arr)-1,2)),4,"целое" )
    Call ms.Run("Solver.xla!SolverAdd", sheet.Range(sheet.Cells(numRowK,2),sheet.Cells(numRowK+Ubound(arr)-1,2)),3,"0" )
    ' ограничение: итоговое кол-во деталей >= требуемое кол-во деталей
    For i%=1 To kolD
        Call ms.Run("Solver.xla!SolverAdd", sheet.Cells(numRowTotals,i%+2),3,"R" & Cstr(numRowNeed) & "C" & Cstr(i%+2) )
    Next i%    
    
    ms.Visible=True
    
    ' Запуск поиска решения (с сохранением найденного решения)
    Call ms.Run("Solver.xla!SolverSolve")