VBA启动文件在哪？怎么删除？
<p>打开某些文件以后出现如下提示：</p><p>AutoCAD 菜单实用程序已加载。正在初始化 VBA 系统...<br/>正在加载 VBA 启动文件...<br/>未找到宏。<br/>未找到宏。</p><p>好像是文件里加载的 读excel表的 程序 </p><p></p><p>我应该怎么删除它？</p><p>下面就是这个宏</p><p>Dim Excel As Excel.Application<br/>Dim ExcelSheet As Object<br/>Dim ExcelWorkbook As Object</p><p></p><p><br/>Public Function merge(str1 As String, str2 As String)</p><p> Excel.Range(str1 & ":" & str2).Select<br/> <br/> Excel.Selection.merge<br/> Excel.Selection.VerticalAlignment = xlVAlignCenter<br/> Excel.Selection.HorizontalAlignment = xlCenter<br/> Excel.Selection.Orientation = xlVertical</p><p>End Function</p><p><br/>Public Function quit()<br/> Dim ret As Integer<br/> ret = MsgBox("是否关闭并保存Excel？", vbYesNo)<br/> If (ret = vbYes) Then<br/> Dim strname As String<br/> strname = InputBox("please input excel file name")<br/> ExcelWorkbook.SaveAs strname<br/> Excel.Application.quit<br/> Set Excel = Nothing<br/> <br/> End If</p><p>End Function</p><p><br/>Public Function border(str1 As String, str2 As String)</p><p> Excel.Range(str1 & ":" & str2).Select<br/> <br/> <br/> Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone<br/> Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone<br/> With Excel.Selection.Borders(xlEdgeLeft)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeTop)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeBottom)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeRight)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlInsideVertical)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlInsideHorizontal)<br/> .LineStyle = xlContinuous<br/> .Weight = xlThin<br/> .ColorIndex = xlAutomatic<br/> End With<br/> </p><p>End Function</p><p>Public Function Border_bold(str1 As String, str2 As String)<br/> Excel.Range(str1 & ":" & str2).Select<br/> Excel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone<br/> Excel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone<br/> With Excel.Selection.Borders(xlEdgeLeft)<br/> .LineStyle = xlContinuous<br/> .Weight = xlMedium<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeTop)<br/> .LineStyle = xlContinuous<br/> .Weight = xlMedium<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeBottom)<br/> .LineStyle = xlContinuous<br/> .Weight = xlMedium<br/> .ColorIndex = xlAutomatic<br/> End With<br/> With Excel.Selection.Borders(xlEdgeRight)<br/> .LineStyle = xlContinuous<br/> .Weight = xlMedium<br/> .ColorIndex = xlAutomatic<br/> End With<br/> Excel.Selection.Borders(xlInsideVertical).LineStyle = xlNone<br/> Excel.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone</p><p>End Function</p><p>Public Function writeExcel()<br/> Dim returnObj As ComSheet<br/> Dim sheet As Integer<br/> <br/> Dim basePnt As Variant<br/> Dim rangeRow As Integer<br/> Dim rangeColumn As Integer<br/> Dim rangeRowMax As Integer<br/> Dim rangeColumnMax As Integer<br/> Dim cell1 As Object<br/> Dim cell2 As Object<br/> <br/> On Error Resume Next<br/> <br/> Set Excel = CreateObject("Excel.Application")<br/> <br/> <br/> <br/> Set ExcelWorkbook = Excel.Workbooks.Add<br/> Set ExcelSheet = Excel.ActiveSheet<br/> Excel.Visible = True<br/> <br/> <br/> On Error Resume Next<br/> <br/> ' The following example waits for a selection from the user<br/> <br/> ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"</p><p> Dim name<br/> name = returnObj.ObjectName<br/> Dim str As String<br/> str = returnObj.TextString<br/> <br/> If Not (name = "TDbSheet") Then<br/> Exit Function<br/> End If<br/> <br/> nRowNum = returnObj.RowNum<br/> nColumnNum = returnObj.ColumnNum<br/> <br/> For j = 0 To nColumnNum - 1 Step 1<br/> For i = 0 To nRowNum - 1 Step 1<br/> If (returnObj.IsRange(i, j)) Then<br/> rangeRow = returnObj.rangeRow(i, j)<br/> rangeColumn = returnObj.rangeColumn(i, j)<br/> rangeRowMax = returnObj.rangeRowMax(i, j)<br/> rangeColumnMax = returnObj.rangeColumnMax(i, j)<br/> Set cell1 = ExcelSheet.Cells(rangeRow + 1, rangeColumn + 1)<br/> Set cell2 = ExcelSheet.Cells(rangeRowMax + 1, rangeColumnMax + 1)<br/> Excel.Range(cell1, cell2).Select<br/> <br/> Excel.Selection.merge<br/> Excel.Selection.VerticalAlignment = xlVAlignCenter<br/> Excel.Selection.HorizontalAlignment = xlCenter<br/> 'Excel.Selection.Orientation = xlVertical<br/> <br/> <br/> End If<br/> ExcelSheet.Cells(i + 1, j + 1).Value = returnObj.Text(i, j)<br/> Next i<br/> Next j<br/> </p><p> <br/> </p><p> returnObj.Color = acRed<br/> </p><p> <br/>End Function</p><p><br/> <br/>Public Sub readExcel()<br/> Dim Excel_cad As Excel.Application<br/> Dim ExcelSheet_cad As Object</p><p> On Error Resume Next<br/> <br/> Set Excel_cad = GetObject(, "Excel.Application")<br/> If Err <> 0 Then<br/> MsgBox ("请先打开一EXCEL文件，并框选中要复制的单元格。")<br/> Set Excel_cad = Nothing<br/> Exit Sub<br/> End If<br/> Dim sheet As ComSheet<br/> Set ExcelSheet_cad = Excel_cad.ActiveSheet<br/> <br/> Dim rowStart As Integer<br/> Dim columnStart As Integer<br/> rowStart = Excel_cad.Selection.row '起点<br/> columnStart = Excel_cad.Selection.column '起点<br/> <br/> <br/> Set sheet = New ComSheet<br/> Dim row As Integer<br/> Dim col As Integer<br/> sheetrow = Excel_cad.Selection.Rows.Count<br/> sheetcol = Excel_cad.Selection.Columns.Count<br/> If (sheetrow < 1 Or sheetcol < 1) Then<br/> Set ExcelSheet_cad = Nothing<br/> Set Excel_cad = Nothing<br/> Exit Sub<br/> End If<br/> <br/> Dim ret As Integer<br/> ret = MsgBox("是否在图中新建一表格？Y-新建，N-更新(注意行列匹配)。", vbYesNo)<br/> If (ret = vbNo) Then<br/> ThisDrawing.Utility.GetEntity sheet, basePnt, "Select an object"<br/> Dim name<br/> name = sheet.ObjectName<br/> <br/> nRowNum = returnObj.RowNum<br/> nColumnNum = returnObj.ColumnNum</p><p> <br/> If Not (name = "TDbSheet") Then<br/> MsgBox ("选择失败！ 请正确选择天正表格。")<br/> Set ExcelSheet_cad = Nothing<br/> Set Excel_cad = Nothing<br/> Exit Sub<br/> End If<br/> If (sheetrow <> sheet.RowNum) Or (sheetcol <> sheet.ColumnNum) Then<br/> MsgBox ("表格行数或列数不匹配！ 请正确选择天正表格。")<br/> Set ExcelSheet_cad = Nothing<br/> Set Excel_cad = Nothing<br/> Exit Sub<br/> End If<br/> <br/> '先把合并单元格恢复<br/> For j = 0 To sheetrow - 1 Step 1<br/> For i = 0 To sheetcol - 1 Step 1<br/> Dim IsMerged As Boolean<br/> IsMerged = sheet.IsRange(j, i)<br/> If (IsMerged = True) Then<br/> sheet.ExplodeCell j, i<br/> End If<br/> Next i<br/> Next j<br/> <br/> Else<br/> sheet.Create sheetrow, sheetcol<br/> End If<br/> <br/> <br/> <br/> <br/> For j = 0 To sheetrow - 1 Step 1<br/> For i = 0 To sheetcol - 1 Step 1<br/> Dim str As String</p><p> Dim r As Range<br/> Dim IsMerge As Boolean<br/> flag = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).MergeCells<br/> IsMerge = sheet.IsRange(j, i)</p><p> If (flag = True And IsMerge = False) Then<br/> Set r = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).MergeArea<br/> MergeStartR = r.row - rowStart '相对于TDbSheet<br/> MergeStartC = r.column - columnStart<br/> MergeCNum = r.Columns.Count<br/> MergeRNum = r.Rows.Count<br/> sheet.merge MergeStartR, MergeStartC, MergeRNum, MergeCNum<br/> End If<br/> If (IsMerge = False) Then<br/> str = ExcelSheet_cad.Cells(rowStart + j, columnStart + i).Text ' sr modify by .Value 2004/6/14<br/> sheet.SetCellText j, i, str<br/> End If<br/> Next i<br/> Next j<br/> ThisDrawing.Regen (acAllViewports)<br/> <br/> 'Excel.Application.quit<br/> Set ExcelSheet_cad = Nothing<br/> Set Excel_cad = Nothing<br/> <br/> <br/>End Sub<br/> <br/>Public Sub sheet2Excel()<br/> Dim OpenFlag As Boolean<br/> OpenFlag = True<br/> <br/> Dim Excel_cad As Excel.Application<br/> Dim ExcelSheet_cad As Object<br/> Dim ExcelWorkbook_cad As Object</p><p> Dim returnObj As ComSheet<br/> Dim sheet As Integer<br/> <br/> Dim basePnt As Variant<br/> Dim rangeRow As Integer<br/> Dim rangeColumn As Integer<br/> Dim rangeRowMax As Integer<br/> Dim rangeColumnMax As Integer<br/> Dim cell1 As Object<br/> Dim cell2 As Object<br/> <br/> On Error Resume Next<br/> <br/> Dim rowStart As Integer<br/> Dim columnStart As Integer<br/> rowStart = 1 '起点<br/> columnStart = 0 '起点</p><p> <br/> ' The following example waits for a selection from the user<br/> <br/> ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an object"</p><p> Dim name<br/> name = returnObj.ObjectName</p><p> If Not (name = "TDbSheet") Then<br/> Exit Sub<br/> End If<br/> <br/> nRowNum = returnObj.RowNum 'ComSheet行数<br/> nColumnNum = returnObj.ColumnNum 'ComSheet列数<br/> <br/>' Dim ret As Integer<br/>' ret = MsgBox("是否在图中新建一Excel表单？Y-新建，N-更新已有表单的选中区域(注意行列匹配)。", vbYesNo)<br/>' If (ret = vbNo) Then<br/>' On Error Resume Next<br/>' Set Excel_cad = GetObject(, "Excel.Application")<br/>' If Err <> 0 Then<br/>' MsgBox ("请先打开一EXCEL文件，并框选中要复制的单元格。")<br/>' Set Excel_cad = Nothing<br/>' Exit Sub<br/>' End If<br/>'<br/>' OpenFlag = False<br/>' rowStart = Excel_cad.Selection.row '起点<br/>' columnStart = Excel_cad.Selection.column '起点<br/>' sheetrow = Excel_cad.Selection.Rows.Count<br/>' sheetcol = Excel_cad.Selection.Columns.Count<br/>' If (sheetrow <> nRowNum) Or (sheetcol <> nColumnNum) Then<br/>' MsgBox ("所选EXCEL表格与天正表格行数或列数不匹配！")<br/>' Set Excel_cad = Nothing<br/>' End If<br/>' Else<br/> OpenFlag = True<br/> Set Excel_cad = CreateObject("Excel.Application")<br/> Set ExcelWorkbook_cad = Excel_cad.Workbooks.Add<br/> 'End If<br/> Set ExcelSheet_cad = Excel_cad.ActiveSheet<br/> <br/> '标题<br/> Set cell1 = ExcelSheet_cad.Cells(rowStart, columnStart + 1)<br/> Set cell2 = ExcelSheet_cad.Cells(rowStart, columnStart + nColumnNum)<br/> <br/> Excel_cad.Range(cell1, cell2).Select<br/> Excel_cad.Selection.merge<br/> Excel_cad.Selection.VerticalAlignment = xlVAlignCenter<br/> Excel_cad.Selection.HorizontalAlignment = xlCenter<br/> Excel_cad.Cells(rowStart, columnStart + 1).Value = returnObj.Title<br/> <br/> <br/> For j = 0 To nColumnNum - 1 Step 1<br/> For i = 0 To nRowNum - 1 Step 1<br/> If (OpenFlag = True) Then<br/> If (returnObj.IsRange(i, j)) Then<br/> rangeRow = returnObj.rangeRow(i, j)<br/> rangeColumn = returnObj.rangeColumn(i, j)<br/> If (i = rangeRow And j = rangeColumn) Then<br/> rangeRowMax = returnObj.rangeRowMax(i, j)<br/> rangeColumnMax = returnObj.rangeColumnMax(i, j)<br/> Set cell1 = ExcelSheet_cad.Cells(rangeRow + rowStart + 1, rangeColumn + columnStart + 1)<br/> Set cell2 = ExcelSheet_cad.Cells(rangeRowMax + rowStart + 1, rangeColumnMax + columnStart + 1)<br/> If returnObj.TextColor(i, j) > 0 Then<br/> Excel_cad.Range(cell1, cell2).Interior.Color = returnObj.TextColor(i, j)<br/> Excel_cad.Range(cell1, cell2).Interior.Pattern = xlSolid<br/> End If<br/> Excel_cad.Range(cell1, cell2).Select<br/> Excel_cad.Selection.merge<br/> Excel_cad.Selection.VerticalAlignment = xlVAlignCenter<br/> Excel_cad.Selection.HorizontalAlignment = xlCenter<br/> End If<br/> Else<br/> If returnObj.TextColor(i, j) > 0 Then<br/> ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Interior.Color = returnObj.TextColor(i, j)<br/> ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Interior.Pattern = xlSolid<br/> End If<br/> End If<br/> ExcelSheet_cad.Cells(i + rowStart + 1, j + columnStart + 1).Value = returnObj.Text(i, j)<br/> Else<br/> ExcelSheet_cad.Cells(i + rowStart, j + columnStart).Value = returnObj.Text(i, j)<br/> End If<br/> Next i<br/> Next j<br/> <br/> Excel_cad.Visible = True<br/> Set ExcelWorkbook_cad = Nothing<br/> Set ExcelSheet_cad = Nothing<br/> Set Excel_cad = Nothing</p><p>End Sub</p><p><br/></p> 呃? 上面的那个 "宏" 对话框里不是提示了是 C:\TagentTarch7\SYS17\acad.dvb 文件吗? 将这个文件改名了试试? <p>找到原因了 我中了acaddoc.lsp病毒了 把acaddoc.lsp删掉 acadapq也删掉 就不卡了</p><p> 但是现在还有提示：</p><p>AutoCAD 菜单实用程序已加载。LOAD 失败: "acadapq" </p><p>这是什么原因？</p>
页:
[1]