0

我有一个现有的 .xlsm 文件，可以完美地与所有宏一起运行。问题是，当我尝试录制另一个宏时，我添加了一个列，按 Enter 键，然后收到消息“Microsoft Excel 已停止响应”。然后我必须结束这个过程。我假设这与从 Excel 2003 导入并修改为适用于 2010 年的现有宏有关。

此宏中是否存在任何可能导致此问题的不兼容性？

 Sub Auto_Open()

    Wbname = ActiveWorkbook.Name  ' this needs to be first so the move works properly
    fileToOpen = Application.GetOpenFilename("CSV files (*.csv), *.csv", 1, "Select file to open")
    If fileToOpen <> False Then
        Workbooks.Open (fileToOpen)
    End If

    sheetname = ActiveSheet.Name

    Sheets(sheetname).Select
    Sheets(sheetname).Move Before:=Workbooks(Wbname).Sheets(1)

    Call Weekly_RTP

 End Sub

Sub Weekly_RTP()
'
' Macro recorded 01/12/12 by Robert Gagliardi
'
'   This next section (up to call sort_data) is needed until we get the formatting correct.
'   Clearing the last rows and adding misc headers will solve the short term problem
'   Need this once pivot table is created.  Can't have heading row without names in it
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Misc"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Misc1"
    Columns("N:Z").Select
    Selection.ClearContents

    Call Sort_data

    ' concat mui & object to make it easy to find dups use countifs once at excel 2007 or greater
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Junk"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]&RC[-5]"
    Range("N2").Select
    Selection.Copy
'    need to find last row using column K2
    lastrow = ActiveSheet.Range("K2").End(xlDown).Select
'    Selection.Offset(0, 3).Select   Moves over 3 cells
    Range("N2", Selection.Offset(0, 3)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Alerts"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R2C[12]:RC15,RC[12])=1,COUNTIF(C[12],RC[12]),"" "")"
    Range("C2").Select
    Selection.Copy
'    need to find last row using column B2 since column C was just added
    lastrow = ActiveSheet.Range("B2").End(xlDown).Select
'    Selection.Offset(0, 1).Select   Moves over 1 cell from last cell in column B
    Range("C2", Selection.Offset(0, 1)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Call Create_pivot
    Call Save_data

'   how to select a range of cells with data in them
'    Worksheets(ActiveSheet.Name).Activate
'    ActiveCell.CurrentRegion.Select

End Sub


Sub Create_pivot()

    Wbname = ActiveWorkbook.Name

'   Insert columns to make room for pivot table
    Columns("A:I").Select
    Selection.Insert Shift:=xlToRight

    myData = Sheets(ActiveSheet.Name).[J1].CurrentRegion.Address
    mySheet = ActiveSheet.Name & "!"
    tableDest = "[" & Wbname & "]" & mySheet & "R1C1"
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        mySheet & myData).CreatePivotTable TableDestination:=tableDest, TableName _
        :="RTP_alerts", DefaultVersion:=xlPivotTableVersionCurrent
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Application")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Object")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("RTP_alerts").AddDataField ActiveSheet.PivotTables( _
        "RTP_alerts").PivotFields("Alerts"), "Count of Alerts", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False

    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Owner"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Problem Ticket"
    Columns("E:E").ColumnWidth = 13
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Comments"
    Columns("F:F").ColumnWidth = 48

End Sub

Sub Save_data()

    Filename = ActiveWorkbook.Name
    Do
        Fname = Application.GetSaveAsFilename(Filename, fileFilter:="Excel Files (*.xlsm), *.xlsm")
    Loop Until Fname <> False
    ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=52

End Sub

Sub Sort_data()

    Columns("A:M").Select
    Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("A1").Select

End Sub
4

1 回答 1

1

我遇到了同样的问题，你可以试试这里。转到start-->run，然后%temp%在框中键入。这将打开您的临时文件。

删除全部或部分，重新​​启动计算机并重试。

于 2012-09-13T19:58:39.630 回答