求助：Excel调用Visio的CreateTile宏传递参数失败，无法调整形状

核心问题 #

你通过Excel的ExecuteLine调用Visio宏时，字符串类型参数（如sTile对应的shapeName01）未被双引号包裹，导致Visio将其识别为变量名而非字面量字符串，触发参数类型不匹配或找不到形状的错误。而直接调用Test宏时参数是在Visio内部定义的，不存在格式问题，因此可以正常运行。

解决方案1：修正参数拼接格式（针对ExecuteLine方式） #

在Excel端拼接参数时，给字符串类型的sTile添加双引号（VBA中用两个双引号表示转义的双引号）：

sParam = CStr(Replace(Round(coords(0), 4), ",", ".")) & ", " & _
         CStr(Replace(Round(coords(1), 4), ",", ".")) & ", " & _
         CStr(ufMain.tBoxWidth.Text) & ", " & _
         CStr(Replace(Round(CDbl(101.6 * ufMain.tBoxWidth.Text / 67.7333), 4), ",", ".")) & ", " & _
         """" & sTile & """"  ' 为字符串参数添加双引号

Debug.Print ("CreateTile " & sParam)
visDoc.ExecuteLine "CreateTile " & sParam

此时Debug输出会变成CreateTile 40, 34.642, 40, 60, "shapeName01"，Visio能正确识别sTile为字符串参数。

解决方案2：改用Application.Run调用（更推荐） #

ExecuteLine依赖字符串拼接，容易出现格式问题；改用Visio.Application.Run可以直接传递参数，无需处理引号，类型匹配更可靠：

Dim visApp As Object
Set visApp = GetObject(, "Visio.Application")  ' 按你的Visio对象获取逻辑调整

' 直接传递参数，无需拼接字符串
visApp.Run "CreateTile", _
           CStr(Replace(Round(coords(0), 4), ",", ".")), _
           CStr(Replace(Round(coords(1), 4), ",", ".")), _
           CStr(ufMain.tBoxWidth.Text), _
           CStr(Replace(Round(CDbl(101.6 * ufMain.tBoxWidth.Text / 67.7333), 4), ",", ".")), _
           sTile

额外优化建议 #

1. 调整Visio宏参数类型：将CreateTile的数值参数改为Double类型，避免字符串转数值的潜在问题：

   Public Sub CreateTile(x As Double, y As Double, lWidth As Double, lHeight As Double, sTile As String)
       Dim dbPage As Visio.Page
       Dim mapPage As Visio.Page
       Dim srcShape As Visio.Shape
       Dim newShape As Visio.Shape
       
       Set dbPage = ActiveDocument.Pages("DB")
       Set mapPage = ActiveDocument.Pages("Map")
       Set srcShape = dbPage.Shapes(sTile)
       
       srcShape.Copy
       Set newShape = mapPage.Paste()  ' 直接获取粘贴后的形状，无需通过ItemFromID
       
       newShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = x & " mm"
       newShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = y & " mm"
       newShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = lWidth & " mm"
       newShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = lHeight & " mm"
   End Sub
   

   对应的Excel端可以直接传递Double类型值，无需转成字符串：

   visApp.Run "CreateTile", _
           Round(coords(0), 4), _
           Round(coords(1), 4), _
           CDbl(ufMain.tBoxWidth.Text), _
           Round(101.6 * CDbl(ufMain.tBoxWidth.Text) / 67.7333, 4), _
           sTile
   

2. 简化新形状获取逻辑：mapPage.Paste()直接返回粘贴后的形状对象，无需通过ItemFromID索引，代码更简洁可靠。

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