VBA代码的奇怪错误在哪

yxh1202

我编写了段代码，想把EXCEL中的文字提取到CAD中，并设为多行文字，对齐方式为正中，但是奇怪的是执行后，最后一列（设计渠底）字高个对齐方式没有变，烦请高人指点啊

 

Sub uu()
Dim insPnt(0 To 2) As Double
 On Error Resume Next  '这句话很重要
      ' 连接Excel应用程序
       Dim xlApp As Excel.Application
     Set xlApp = GetObject(, "Excel.Application")
     If Err Then
         MsgBox " Excel 应用程序没有运行。请启动 Excel 并重新运行程序。"
         Exit Sub
     End If
     Dim xlSheet As Worksheet
     Set xlSheet = xlApp.ActiveSheet
zg = 2.5
For p = 1 To 6
     txtStr = xlSheet.Cells(1, p)
      txtHeight = 25
      insPnt(0) = 100: insPnt(1) = 100 - p * 15 + 8.5: insPnt(2) = 0
      mtextObj.AttachmentPoint = 5
      mtextObj.height = 2 * zg
      Set mtextObj = ThisDrawing.ModelSpace.AddMText(insPnt, txtHeight, txtStr)
         Next p
End Sub

 

电子表格里的第一行是如下内容

 

桩号	现状渠顶	设计渠顶	设计水位	现状渠底	设计渠底

 

 

woaishuijia

For p = 1 To 6
     txtStr = xlSheet.Cells(1, p)
      txtHeight = 2 * zg
      insPnt(0) = 100: insPnt(1) = 100 - p * 15 + 8.5: insPnt(2) = 0
      Set mtextObj = ThisDrawing.ModelSpace.AddMText(insPnt, txtHeight, txtStr)
      mtextObj.AttachmentPoint = 5

Next p

yxh1202

谢谢，就是把字高属性语句放到最后。可是为何放在前面就出现最后一行没有执行字高呢。百思不得其解。不过还是谢谢你啊

woaishuijia

按你的代码,进入FOR循环时,先设置mtextObj的对正和字高属性,可这时mtextObj对象还没有创建,mtextObj还不存在,这时修改其属性的两行语句一定会出错.但你在代码的最前面有一行On Error Resume Next,尽管你的本意是用这个错误处理代码来检测EXCEL程序是否运行,但到了循环语句时,这一句还在发挥作用,程序不会报错而是越过出错的两行代码向下运行到创建mtextObj这一行.创建一个mtextObj对象后程序又回到循环体的前面,设置mtextObj的对正和字高属性,这次不会出错了,但这次被设置属性的是第一次创建的mtextObj对象,然后再创建第二个mtextObj,然后再回去......直到创建最后一个mtextObj后直接退出循环.最后一个mtextObj并没有修改属性.

如果你在进入循环体之前,加一行On Error Goto 0,让前面的On Error Resume Next失效,你就会发现修改属性的两行放在这里是错误的.

所以我对你的代码做的修改主要就是先创建对象,再修改属性,仅此而已.

另外,你在创建对象时使用的字高和后面修改的字高不一致,好像没有必要吧?所以对此也一并做了修改,在创建对象时直接按要求指定字高,而不再修改字高属性.

 

yxh1202

谢谢楼上的帮助。

但是addmext(坐标，多行文字宽度，文字）

我定义txtheight=25是为了不重新定义变量

 

Set mtextObj = ThisDrawing.ModelSpace.AddMText(insPnt, txtHeight, txtStr)

 

mtextObj.height = 2 * zg  ‘这一句才是为多行文字赋字高属性啊。

不知道对不对，请多指教

woaishuijia

对不起,是我搞错了.呵呵,我把单行文字和多行文字搞混了.

你是对的,为多行文字赋予字高应该有.

luna125

取之于明 用之于明