程序运行出现的问题

weixin7944

程序如下：

Option Explicit

' 使用Excel数据表中的数据绘制一条直线
Public Sub UseExcelData()
    Dim excelApp As Excel.Application
    Dim excelSheet As Excel.Worksheet
   
 
   
    ' 运行Excel应用程序
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = True
   
    ' 打开指定的Excel文件，获得指定的页
    excelApp.Workbooks.Open "d:\demo.xls"
    Set excelSheet = excelApp.ActiveWorkbook.Sheets("Sheet1")
   
    ' 使用指定页的数据绘图
    Dim lineObj As AcadLine
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
   
    startPoint(0) = excelSheet.Cells(1, 1).Value
    startPoint(1) = excelSheet.Cells(1, 2).Value
    startPoint(2) = excelSheet.Cells(1, 3).Value
    endPoint(0) = excelSheet.Cells(2, 1).Value
    endPoint(1) = excelSheet.Cells(2, 2).Value
    endPoint(2) = excelSheet.Cells(2, 3).Value
       
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    ZoomAll
   
    ' 退出Excel应用程序
    excelApp.Quit
End Sub

程序一运行，就开始安装EXCEL，因为没有光盘，安装失败！可是实际上我的电脑上已经安装了EXCEL,不知道什么？请帮助解决，谢谢！

jxh2003zfr

放入安装盘,运行一次EXCEL后即可!

weixin7944

还是不行，说是找不到安装所需文件SKU011.CAB。请指教！能否告知原因问什么会出现这种问题？

sdxylijian

建议excel和CAD两个软件安装的时候选择全部安装，可以解决一些不可预知的问题，供参考。

jxh2003zfr

如果单独开启EXCEL或WORD也有此问题，则应该放入安装盘开启EXCEL更新一次即可。你的EXCEL是否不是在你当前用户下安装的！所以会出现此情况，如果切换到安装的路径，则不会这样！

weixin7944

我将EXCEL 重装了一次，问题解决了。但是，程序运行后，有时是成功的，但有时是失败的。而且，程序运行后每次重新打开那个EXCEL文件，都是只读形式的。程序如下：

Private Sub CommandButton1_Click()
 
     On Error Resume Next
  Set xlapp = GetObject(, "excel.application")
  If Err Then
  Err.Clear
  Set xlapp = CreateObject("excel.application")
  If Err Then
  Err.Clear
  MsgBox ("不能运行EXCEL，请检查是否安装了EXCEL")
  Exit Sub
  End If
  End If
   xlapp.workbooks.Open "D:\book3.xls"
    Set xlsheet = xlapp.activesheet
  xlsheet.range("a2").Value = "试验"
  activeworkbook.Save
  activeworkbook.Close
   
End Sub

请问是什么原因？

mayuezxl

   activeworkbook.Save
  activeworkbook.Close
把这两句改成以下两句试试

 xlapp.Quit '==========退出Excel
   Set xlapp = Nothing '===把控制权让给Excel

weixin7944

经过高手的指导，上述问题已解决，谢谢！但是新的问题产生了：程序执行后，出现提示：是否保存对“BOOK3.XLS”的更改？，之后我又将activeworkbook.save加上去，可还是不行，请高手指点，该怎样实现对XLS文件的自动保存？总的程序如下：

Private Sub CommandButton1_Click()
  ' 安全创建选择集
    On Error Resume Next
    Dim SSet As AcadSelectionSet
    If Not IsNull(ThisDrawing.SelectionSets.Item("Example")) Then
        Set SSet = ThisDrawing.SelectionSets.Item("Example")
        SSet.Delete
    End If
    Set SSet = ThisDrawing.SelectionSets.Add("Example")
   
 Dim fType As Variant, fData As Variant      ' 选择集过滤器
    Call CreateSSetFilter(fType, fData, 2, "title")
    SSet.Select acSelectionSetAll, , , fType, fData
   
    '获取TITLE信息
Dim Cnt As Integer
Dim ssss As String
ssss = ""
Dim exltagname_1 As String
Dim acadBlkTitleRef As AcadBlockReference
Dim acadAttrTitle As AcadAttribute
Dim varAttributes As Variant
Set acadBlkTitleRef = SSet.Item(0)
varAttributes = acadBlkTitleRef.GetAttributes
For Cnt = LBound(varAttributes) To UBound(varAttributes)
 Select Case varAttributes(Cnt).TagString
            Case "TITLE-CN-1"
                  exltagname_1 = varAttributes(Cnt).TextString
            Case "TITLE-CN-2"
                 exltagname_2 = varAttributes(Cnt).TextString
            Case "TITLE-CN-3"
                 exltagname_3 = varAttributes(Cnt).TextString
            Case "TITLE-CN-4"
                 exltagname_4 = varAttributes(Cnt).TextString
           End Select
    Next
   MsgBox exltagtag
    ' 删除选择集
    SSet.Delete
     On Error Resume Next
  Set xlapp = GetObject(, "excel.application")
  If Err Then
  Err.Clear
  Set xlapp = CreateObject("excel.application")
  If Err Then
  Err.Clear
  MsgBox ("不能运行EXCEL，请检查是否安装了EXCEL")
  Exit Sub
  End If
  End If

 xlapp.workbooks.Open "D:\book3.xls"
    Set xlsheet = xlapp.activesheet
  xlsheet.range("A2").Value = exltagname_1
  activeworkbook.Save
 xlapp.Quit
  Set xlsheet = Nothing
  Set xlbook = Nothing
  Set xlapp = Nothing
  End Sub

另外一个问题，exltagname_1的值总是传不出来，故EXCEL文件中A2的值未更改。且用MSGBOX exltagname_1都显示不出他的值。但是exltagname_1对应的varAttributes(0).TextString的值却能够显示出来！请问为什么，该怎样解决？谢谢！

mayuezxl

 Set xlapp = GetObject(, "excel.application")
   xlapp.Workbooks.Open FileName:="d:\book3.xls"
   xlapp.Worksheets("sheet1").Range("A2").Value = exltagname_1

weixin7944

经过高手的指导，第二个问题已解决，谢谢！但是第一个问题：程序执行后，出现提示：是否保存对“BOOK3.XLS”的更改？，之后我又将activeworkbook.save加上去，可还是不行，请高手指点，该怎样实现对XLS文件的自动保存？