VBA启动文件在哪？怎么删除？

flowersoul

打开某些文件以后出现如下提示：

AutoCAD 菜单实用程序已加载。正在初始化 VBA 系统...
正在加载 VBA 启动文件...
未找到宏。
未找到宏。

好像是文件里加载的 读excel表的 程序

我应该怎么删除它？

下面就是这个宏

Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object

Public Function merge(str1 As String, str2 As String)

    Excel.Range(str1 & ":" & str2).Select
    
    Excel.Selection.merge
    Excel.Selection.VerticalAlignment = xlVAlignCenter
    Excel.Selection.HorizontalAlignment = xlCenter
    Excel.Selection.Orientation = xlVertical

End Function

Public Function quit()
    Dim ret As Integer
    ret = MsgBox("是否关闭并保存Excel？", vbYesNo)
    If (ret = vbYes) Then
        Dim strname As String
        strname = InputBox("please input excel file name")
        ExcelWorkbook.SaveAs strname
        Excel.Application.quit
        Set Excel = Nothing
   
    End If

End Function

Public Function border(str1 As String, str2 As String)

    Excel.Range(str1 & ":" & str2).Select
   
 
    Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Excel.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
 

End Function

Public Function Border_bold(str1 As String, str2 As String)
    Excel.Range(str1 & ":" & str2).Select
    Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Excel.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Excel.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Excel.Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Excel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Function

Public Function writeExcel()
    Dim returnObj As ComSheet
    Dim sheet As Integer
   
    Dim basePnt As Variant
    Dim rangeRow As Integer
    Dim rangeColumn As Integer
    Dim rangeRowMax As Integer
    Dim rangeColumnMax As Integer
    Dim cell1 As Object
    Dim cell2 As Object
   
    On Error Resume Next
 
    Set Excel = CreateObject("Excel.Application")
  
   
       
    Set ExcelWorkbook = Excel.Workbooks.Add
    Set ExcelSheet = Excel.ActiveSheet
    Excel.Visible = True
 
   
    On Error Resume Next
   
    ' The following example waits for a selection from the user
 
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"

    Dim name
    name = returnObj.ObjectName
    Dim str As String
    str = returnObj.TextString
   
    If Not (name = "TDbSheet") Then
        Exit Function
    End If
   
    nRowNum = returnObj.RowNum
    nColumnNum = returnObj.ColumnNum
   
    For j = 0 To nColumnNum - 1 Step 1
        For i = 0 To nRowNum - 1 Step 1
            If (returnObj.IsRange(i, j)) Then
                rangeRow = returnObj.rangeRow(i, j)
                rangeColumn = returnObj.rangeColumn(i, j)
                rangeRowMax = returnObj.rangeRowMax(i, j)
                rangeColumnMax = returnObj.rangeColumnMax(i, j)
                Set cell1 = ExcelSheet.Cells(rangeRow + 1, rangeColumn + 1)
                Set cell2 = ExcelSheet.Cells(rangeRowMax + 1, rangeColumnMax + 1)
                Excel.Range(cell1, cell2).Select
    
                Excel.Selection.merge
                Excel.Selection.VerticalAlignment = xlVAlignCenter
                Excel.Selection.HorizontalAlignment = xlCenter
                'Excel.Selection.Orientation = xlVertical
   
               
            End If
            ExcelSheet.Cells(i + 1, j + 1).Value = returnObj.Text(i, j)
        Next i
    Next j
   

   
   

    returnObj.Color = acRed
   

   
End Function

 
Public Sub readExcel()
    Dim Excel_cad As Excel.Application
    Dim ExcelSheet_cad As Object

    On Error Resume Next
   
    Set Excel_cad = GetObject(, "Excel.Application")
    If Err <> 0 Then
        MsgBox ("请先打开一EXCEL文件，并框选中要复制的单元格。")
        Set Excel_cad = Nothing
        Exit Sub
    End If
    Dim sheet As ComSheet
    Set ExcelSheet_cad = Excel_cad.ActiveSheet
    
    Dim rowStart As Integer
    Dim columnStart As Integer
    rowStart = Excel_cad.Selection.row             '起点
    columnStart = Excel_cad.Selection.column       '起点
   
 
    Set sheet = New ComSheet
    Dim row As Integer
    Dim col As Integer
    sheetrow = Excel_cad.Selection.Rows.Count
    sheetcol = Excel_cad.Selection.Columns.Count
    If (sheetrow < 1 Or sheetcol < 1) Then
        Set ExcelSheet_cad = Nothing
        Set Excel_cad = Nothing
        Exit Sub
    End If
   
    Dim ret As Integer
    ret = MsgBox("是否在图中新建一表格？Y-新建，N-更新(注意行列匹配)。", vbYesNo)
    If (ret = vbNo) Then
        ThisDrawing.Utility.GetEntity sheet, basePnt, "Select an object"
        Dim name
        name = sheet.ObjectName
        
        nRowNum = returnObj.RowNum
        nColumnNum = returnObj.ColumnNum

   
        If Not (name = "TDbSheet") Then
            MsgBox ("选择失败！ 请正确选择天正表格。")
            Set ExcelSheet_cad = Nothing
            Set Excel_cad = Nothing
            Exit Sub
        End If
        If (sheetrow <> sheet.RowNum) Or (sheetcol <> sheet.ColumnNum) Then
            MsgBox ("表格行数或列数不匹配！ 请正确选择天正表格。")
            Set ExcelSheet_cad = Nothing
            Set Excel_cad = Nothing
            Exit Sub
        End If
     
        '先把合并单元格恢复
        For j = 0 To sheetrow - 1 Step 1
            For i = 0 To sheetcol - 1 Step 1
                Dim IsMerged As Boolean
                IsMerged = sheet.IsRange(j, i)
                If (IsMerged = True) Then
                    sheet.ExplodeCell j, i
                End If
             Next i
        Next j
   
    Else
        sheet.Create sheetrow, sheetcol
    End If
   
          
           
   
    For j = 0 To sheetrow - 1 Step 1
        For i = 0 To sheetcol - 1 Step 1
            Dim str As String

            Dim r As Range
            Dim IsMerge As Boolean
            flag = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).MergeCells
            IsMerge = sheet.IsRange(j, i)

            If (flag = True And IsMerge = False) Then
                Set r = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).MergeArea
                MergeStartR = r.row - rowStart        '相对于TDbSheet
                MergeStartC = r.column - columnStart
                MergeCNum = r.Columns.Count
                MergeRNum = r.Rows.Count
                sheet.merge MergeStartR, MergeStartC, MergeRNum, MergeCNum
            End If
            If (IsMerge = False) Then
               str = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).Text ' sr modify by .Value 2004/6/14
               sheet.SetCellText j, i, str
            End If
        Next i
    Next j
    ThisDrawing.Regen (acAllViewports)
   
    'Excel.Application.quit
    Set ExcelSheet_cad = Nothing
    Set Excel_cad = Nothing
   
    
End Sub
 
Public Sub sheet2Excel()
    Dim OpenFlag As Boolean
    OpenFlag = True
   
    Dim Excel_cad As Excel.Application
    Dim ExcelSheet_cad As Object
    Dim ExcelWorkbook_cad As Object

    Dim returnObj As ComSheet
    Dim sheet As Integer
   
    Dim basePnt As Variant
    Dim rangeRow As Integer
    Dim rangeColumn As Integer
    Dim rangeRowMax As Integer
    Dim rangeColumnMax As Integer
    Dim cell1 As Object
    Dim cell2 As Object
   
    On Error Resume Next
 
    Dim rowStart As Integer
    Dim columnStart As Integer
    rowStart = 1            '起点
    columnStart = 0         '起点

    
    ' The following example waits for a selection from the user
 
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"

    Dim name
    name = returnObj.ObjectName

    If Not (name = "TDbSheet") Then
        Exit Sub
    End If
   
    nRowNum = returnObj.RowNum                'ComSheet行数
    nColumnNum = returnObj.ColumnNum          'ComSheet列数
   
'    Dim ret As Integer
'    ret = MsgBox("是否在图中新建一Excel表单？Y-新建，N-更新已有表单的选中区域(注意行列匹配)。", vbYesNo)
'    If (ret = vbNo) Then
'        On Error Resume Next
'        Set Excel_cad = GetObject(, "Excel.Application")
'        If Err <> 0 Then
'            MsgBox ("请先打开一EXCEL文件，并框选中要复制的单元格。")
'            Set Excel_cad = Nothing
'            Exit Sub
'        End If
'
'        OpenFlag = False
'        rowStart = Excel_cad.Selection.row             '起点
'        columnStart = Excel_cad.Selection.column       '起点
'        sheetrow = Excel_cad.Selection.Rows.Count
'        sheetcol = Excel_cad.Selection.Columns.Count
'        If (sheetrow <> nRowNum) Or (sheetcol <> nColumnNum) Then
'            MsgBox ("所选EXCEL表格与天正表格行数或列数不匹配！")
'            Set Excel_cad = Nothing
'        End If
'    Else
        OpenFlag = True
        Set Excel_cad = CreateObject("Excel.Application")
        Set ExcelWorkbook_cad = Excel_cad.Workbooks.Add
    'End If
    Set ExcelSheet_cad = Excel_cad.ActiveSheet
   
    '标题
    Set cell1 = ExcelSheet_cad.Cells(rowStart, columnStart + 1)
    Set cell2 = ExcelSheet_cad.Cells(rowStart, columnStart + nColumnNum)
   
    Excel_cad.Range(cell1, cell2).Select
    Excel_cad.Selection.merge
    Excel_cad.Selection.VerticalAlignment = xlVAlignCenter
    Excel_cad.Selection.HorizontalAlignment = xlCenter
    Excel_cad.Cells(rowStart, columnStart + 1).Value = returnObj.Title
       
   
    For j = 0 To nColumnNum - 1 Step 1
        For i = 0 To nRowNum - 1 Step 1
            If (OpenFlag = True) Then
               If (returnObj.IsRange(i, j)) Then
                   rangeRow = returnObj.rangeRow(i, j)
                   rangeColumn = returnObj.rangeColumn(i, j)
                   If (i = rangeRow And j = rangeColumn) Then
                        rangeRowMax = returnObj.rangeRowMax(i, j)
                        rangeColumnMax = returnObj.rangeColumnMax(i, j)
                        Set cell1 = ExcelSheet_cad.Cells(rangeRow + rowStart + 1, rangeColumn + columnStart + 1)
                        Set cell2 = ExcelSheet_cad.Cells(rangeRowMax + rowStart + 1, rangeColumnMax + columnStart + 1)
                        If returnObj.TextColor(i, j) > 0 Then
                             Excel_cad.Range(cell1, cell2).Interior.Color = returnObj.TextColor(i, j)
                             Excel_cad.Range(cell1, cell2).Interior.Pattern = xlSolid
                        End If
                        Excel_cad.Range(cell1, cell2).Select
                        Excel_cad.Selection.merge
                        Excel_cad.Selection.VerticalAlignment = xlVAlignCenter
                        Excel_cad.Selection.HorizontalAlignment = xlCenter
                    End If
               Else
                   If returnObj.TextColor(i, j) > 0 Then
                      ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Interior.Color = returnObj.TextColor(i, j)
                      ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Interior.Pattern = xlSolid
                   End If
               End If
               ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Value = returnObj.Text(i, j)
            Else
                ExcelSheet_cad.Cells(i + rowStart, j + columnStart).Value = returnObj.Text(i, j)
            End If
        Next i
    Next j
   
    Excel_cad.Visible = True
    Set ExcelWorkbook_cad = Nothing
    Set ExcelSheet_cad = Nothing
    Set Excel_cad = Nothing

End Sub

dunkel

呃? 上面的那个 "宏" 对话框里不是提示了是 C:\TagentTarch7\SYS17\acad.dvb 文件吗? 将这个文件改名了试试?

flowersoul

找到原因了 我中了acaddoc.lsp病毒了 把acaddoc.lsp删掉 acadapq也删掉 就不卡了

 但是现在还有提示：

AutoCAD 菜单实用程序已加载。LOAD 失败: "acadapq"

这是什么原因？