为什么我的 VBA 代码可以在 Windows 7 中运行,但不能在 10 中运行,我该如何解决这个错误?

时间:2021-05-28 18:05:01

标签: excel vba

这是我第一次发帖,如果我没有遵守本论坛通常的格式规则,我深表歉意。

所以,我使用这个 VBA 表已经有一段时间了,但由于 Windows 10 迁移,我无法运行宏。我一直在尝试解决这个问题,但我缺乏技能阻碍了我。该宏只是根据日期对甘特图进行排序。

这是我得到的错误。 Run Time Error - 1004

这是代码错误的图像。 Debugging Error

&这里是完整的代码供您参考。

Option Explicit

Sub SortMe()
'

    Range("I4").Select
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add _
        Key:=Range("Table1[[#All],[Start Date]]"), SortOn:=xlSortOnValues, Order _
        :=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add _
        Key:=Range("Table1[[#All],[Start Date]]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Columns("L:CQ").Select
    Selection.Delete Shift:=xlToLeft
    
    Range("L3").Select
    ActiveCell.FormulaR1C1 = Date
    
    Dim i As Integer
    For i = 1 To 83
    
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = Date + i
    
    Next i
    
    Columns("L:CQ").Select
    Selection.ColumnWidth = 1.43
    
    Dim RowCount As Integer
    RowCount = Range("C4").End(xlDown).Row - 3
    
    Dim FirstCol, LastCol As String
    FirstCol = Format(Date, "m/d/yyyy")
    LastCol = Format(Date + 83, "m/d/yyyy")
    
    'Add the formulas for Gantt
    Range("L4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(DATEVALUE(R3C)>=RC9,DATEVALUE(R3C)<=RC9+RC11),IF(LEN(RC4)<3,2,1),"""")"
    Range("Table1[" & FirstCol & "]").Select
    Selection.AutoFill Destination:=Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]"), _
        Type:=xlFillDefault
    Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
    
    
    'Formatting Gantt Chart
    Range("L4").Select
    Cells.FormatConditions.Delete
    Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -4165632
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 12611584
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=2"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16777024
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    'Add Months
    Rows("2:2").Select
    Rows("2:2").EntireRow.Delete
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    Range("L2").Select
    ActiveCell.FormulaR1C1 = Date
    
    For i = 1 To 83
    
        ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = Date + i
        ActiveCell.NumberFormat = "mmm"
    
    Next i

    Dim Bcell As Range
    Dim MergeRange As String
    Dim CurMonth As Integer
    CurMonth = Month(Range("L2"))
    MergeRange = "$L$2:"
    
    Application.DisplayAlerts = False
    
    For Each Bcell In Range("L2").Resize(1, 84)
    
        If CurMonth <> Month(Bcell) Then
            'MsgBox "New month at " & Bcell.Address
            MergeRange = MergeRange & Bcell.Offset(0, -1).Address
            Range(MergeRange).Select
            Selection.Merge
            
                Selection.NumberFormat = "mmmm"
                With Selection
                    .HorizontalAlignment = xlGeneral
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
                Selection.Font.Bold = True
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                Selection.Font.Size = 16
            
            MergeRange = Bcell.Address & ":"
            
        End If
        CurMonth = Month(Bcell)

    Next Bcell
    
    'Merge last month
    MergeRange = MergeRange & "$CQ$2"
    Range(MergeRange).Select
    Selection.Merge
    
    'format last month
    Selection.NumberFormat = "mmmm"
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Size = 16

End Sub

0 个答案:

没有答案
相关问题