MacOS下Excel中OpenSolver与VBA集成失败问题求助

环境回顾 #

• Excel版本：MacOS Microsoft Excel 16.0
• OpenSolver版本：2.9.3 Linear
• 问题：执行VBA调用OpenSolver方法时触发运行时错误1004：对象'_Application'的方法'Run'失败，直接在立即窗口调用也报错。

针对疑问的解决方案 #

1. 确保MacOS下VBA正确访问OpenSolver方法

• 验证加载项状态：在代码开头添加加载检查，确认OpenSolver已被Excel正确加载：

  Dim addIn As AddIn
  On Error Resume Next
  Set addIn = Application.AddIns("OpenSolver")
  On Error GoTo ErrorHandler
  If addIn Is Nothing Or Not addIn.Installed Then
      MsgBox "OpenSolver加载项未安装或未加载", vbCritical
      Exit Sub
  End If
  

• 改用Application.Run显式调用：MacOS下直接调用OpenSolver_xxx方法可能因命名空间冲突失败，替换为通过宏名称调用：
  原代码：OpenSolver_DeleteAllConstraints
  修改后：Application.Run "OpenSolver_DeleteAllConstraints"

2. 无路径依赖的可靠集成方式

• 放弃VBA直接引用：取消VBA编辑器中OpenSolver的引用，全部改用Application.Run调用宏，避免因文件路径变化导致引用失效。
• 设置自动加载：将OpenSolver添加到Excel的「加载项」列表（工具→加载项→浏览选择OpenSolver.xlam），勾选「始终加载」，确保每次启动Excel自动加载加载项，无需手动打开xlam文件。

3. MacOS特定设置与权限

• 宏权限设置：打开Excel→设置→安全性与隐私，将宏设置为「启用所有宏」（若OpenSolver已签名，可选择「启用签名宏」）。
• 文件权限：将OpenSolver.xlam移动到本地非同步目录，比如~/Library/Application Support/Microsoft/Office/Add-Ins，避免iCloud同步或系统保护目录的权限限制；同时在系统偏好设置→安全性与隐私→隐私→文件与文件夹中，勾选允许Excel访问该目录。

调整后的示例代码 #

Sub SolveTSP_OpenSolver()
    On Error GoTo ErrorHandler
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' 检查OpenSolver加载状态
    Dim addIn As AddIn
    On Error Resume Next
    Set addIn = Application.AddIns("OpenSolver")
    On Error GoTo ErrorHandler
    If addIn Is Nothing Or Not addIn.Installed Then
        MsgBox "OpenSolver加载项未安装或未加载", vbCritical
        Exit Sub
    End If
    
    ' 定义距离矩阵、决策变量等范围
    Dim distRange As Range, xRange1 As Range, xRange2 As Range, uRange As Range, objCell As Range
    Set distRange = ws.Range("I3:V16") ' 距离矩阵
    Set xRange1 = ws.Range("I20:V33") ' 决策变量范围1
    Set xRange2 = ws.Range("I40:V53") ' 决策变量范围2
    Set uRange = ws.Range("W20:W33") ' 顺序变量
    Set objCell = ws.Range("D23") ' 目标函数单元格
    
    ' 定义目标函数：最小化总距离
    objCell.Formula = "=SUMPRODUCT(I20:V33, I3:V16) + SUMPRODUCT(I40:V53, I3:V16)"
    MsgBox "Objective function defined."
    
    ' 清除之前的模型定义
    Debug.Print "Clearing previous model definitions"
    Application.Run "OpenSolver_DeleteAllConstraints"
    Application.Run "OpenSolver_ClearObjective"
    
    ' 设置目标函数
    Debug.Print "Setting the objective function"
    Application.Run "OpenSolver_SetObjective", "MIN", objCell.Address
    MsgBox "Objective function set successfully"
    
    ' 添加行约束：xRange1 + xRange2每行和为1
    Debug.Print "Adding row constraints"
    Dim i As Integer, j As Integer
    For i = 20 To 33
        Debug.Print "Adding row constraint for row " & i
        Application.Run "OpenSolver_AddConstraint", ws.Cells(i, 9).Resize(1, 14).Address & " + " & ws.Cells(i + 20, 9).Resize(1, 14).Address & " = 1"
    Next i
    MsgBox "Row constraints added successfully"
    
    ' 添加列约束：xRange1 + xRange2每列和为1
    Debug.Print "Adding column constraints"
    For j = 9 To 22
        Debug.Print "Adding column constraint for column " & j
        Application.Run "OpenSolver_AddConstraint", ws.Cells(20, j).Resize(14, 1).Address & " + " & ws.Cells(40, j).Resize(14, 1).Address & " = 1"
    Next j
    MsgBox "Column constraints added successfully"

    ' 添加子回路消除约束 u_i + 1 <= u_j + N(1 - x_ij)
    Debug.Print "Adding sub-tour elimination constraints"
    Dim N As Integer
    N = 14 ' 节点数量（0到13）
    For i = 21 To 33
        For j = 10 To 22
            If i <> j Then
                Debug.Print "Adding sub-tour elimination constraint for i = " & i & ", j = " & j
                Application.Run "OpenSolver_AddConstraint", ws.Cells(i, 23).Address & " + 1 <= " & ws.Cells(j - 12 + 20, 23).Address & " + " & CStr(N) & " * (1 - " & ws.Cells(i - 1 + 20, j).Address & ")"
            End If
        Next j
    Next i
    MsgBox "Sub-tour elimination constraints added successfully"
    
    ' 设置决策变量为二进制
    Debug.Print "Setting decision variables as binary"
    Application.Run "OpenSolver_SetBinary", xRange1.Address
    Application.Run "OpenSolver_SetBinary", xRange2.Address
    MsgBox "Decision variables set as binary successfully"

    ' 求解问题
    Debug.Print "Solving the problem"
    Application.Run "OpenSolver_Solve"
    MsgBox "Solver run completed successfully!", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Sub

内容的提问来源于stack exchange，提问作者Max