excel - Access 中的 VBA 代码用于从查询导出中创建具有多个条件格式规则的 Excel 文件

Question

我一直在利用这里的其他一些问题来尝试为这个特定功能拼凑我的代码。结果是这样的：

Private Sub btnExportComparisonResult_Click()
Dim xlapp As New Excel.Application
Dim wb As Workbook
Dim sheet As Worksheet
Dim rng As Object
    
    
DoCmd.Hourglass True
DoCmd.SetWarnings False

kitnum1 = fncGetViewingNum1()
kitnum2 = fncGetViewingNum2()

    DoCmd.RunSQL "DELETE FROM temp_COMPARE "
    DoCmd.RunSQL "INSERT INTO temp_COMPARE ( Type, COMPARE1_OSPN, COMPARE1_Quantity, COMPARE1_Desc, COMPARE2_OSPN, COMPARE2_Quantity, COMPARE2_Desc ) " _
                & "SELECT '1' AS Type, COMPARE1.OSPN, COMPARE1.Quantity, COMPARE1.Desc, COMPARE2.OSPN, COMPARE2.Quantity, COMPARE2.Desc " _
                & "FROM COMPARE1 INNER JOIN COMPARE2 ON (COMPARE1.Quantity = COMPARE2.Quantity) AND (COMPARE1.OSPN = COMPARE2.OSPN) " _
                & "ORDER BY COMPARE1.OSPN; "
    DoCmd.RunSQL "INSERT INTO temp_COMPARE ( Type, COMPARE1_OSPN, COMPARE1_Quantity, COMPARE1_Desc, COMPARE2_OSPN, COMPARE2_Quantity, COMPARE2_Desc ) " _
                & "SELECT '2' AS Type, COMPARE1.OSPN, COMPARE1.Quantity, COMPARE1.Desc, COMPARE2.OSPN, COMPARE2.Quantity, COMPARE2.Desc " _
                & "FROM COMPARE1 INNER JOIN COMPARE2 ON COMPARE1.OSPN = COMPARE2.OSPN " _
                & "WHERE (((COMPARE1.Quantity) <> [COMPARE2].[Quantity])) " _
                & "ORDER BY COMPARE1.OSPN; "
    DoCmd.RunSQL "INSERT INTO temp_COMPARE ( Type, COMPARE1_OSPN, COMPARE1_Quantity, COMPARE1_Desc, COMPARE2_OSPN, COMPARE2_Quantity, COMPARE2_Desc ) " _
                & "SELECT '3' AS Type, COMPARE1.OSPN, COMPARE1.Quantity, COMPARE1.Desc, COMPARE2.OSPN, COMPARE2.Quantity, COMPARE2.Desc " _
                & "FROM COMPARE1 LEFT JOIN COMPARE2 ON COMPARE1.OSPN = COMPARE2.OSPN " _
                & "WHERE (((COMPARE2.OSPN) Is Null)); "
    DoCmd.RunSQL "INSERT INTO temp_COMPARE ( Type, COMPARE1_OSPN, COMPARE1_Quantity, COMPARE1_Desc, COMPARE2_OSPN, COMPARE2_Quantity, COMPARE2_Desc ) " _
                & "SELECT '4' AS Type, COMPARE1.OSPN, COMPARE1.Quantity, COMPARE1.Desc, COMPARE2.OSPN, COMPARE2.Quantity, COMPARE2.Desc " _
                & "FROM COMPARE1 RIGHT JOIN COMPARE2 ON COMPARE1.OSPN = COMPARE2.OSPN " _
                & "WHERE (((COMPARE1.OSPN) Is Null)); "

        strFolder = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Downloads"
        strFileDate = Format(DatePart("m", Date), "00") & "." & Format(DatePart("d", Date), "00") & "." & Right(DatePart("yyyy", Date), 2)
        strFile = "Compare Kits " & kitnum1 & " & " & kitnum2 & " - " & strFileDate & ".xlsx"
            
        DoCmd.TransferSpreadsheet acExport, 10, "qryExportCOMPARE", strFolder & "\" & strFile, , "Compare"
        
        StartTime = DateAdd("s", 2, Now())
            Do While Now() < StartTime
                DoEvents
            Loop
        
        Set xlsobj = CreateObject("excel.application")

        Set wb = xlsobj.Workbooks.Open(strFolder & "\" & strFile)
                            
            With wb.Worksheets("Compare")
                .Columns("A:Z").AutoFit
                
                .Rows("1:1").Font.Bold = True
                
                .Columns("A:A").Delete Shift:=xlToLeft
                
                .Range("$D:$F").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
                
                With .Range("$B:$B,$E:$E")
                    .FormatConditions.Add Type:=xlExpression, Formula1:="=$B1<>$E1"
                    .FormatConditions(.FormatConditions.Count).SetFirstPriority
                    With .FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = 65535
                        .TintAndShade = 0
                    End With
                End With
                
                With .Range("$A:$F")
                    .FormatConditions.Add Type:=xlExpression, Formula1:="=$A1<>$D1"
                    .FormatConditions(.FormatConditions.Count).SetFirstPriority
                    With .FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = 65535
                        .TintAndShade = 0
                    End With
                End With
                
                With .Range("$A:$F")
                    .FormatConditions.Add Type:=xlExpression, Formula1:="=ISBLANK(A1)=TRUE"
                    .FormatConditions(.FormatConditions.Count).SetFirstPriority
                    .FormatConditions(1).StopIfTrue = True
                End With
                
                With .Range("1:1")
                    .FormatConditions.Add Type:=xlExpression, Formula1:="=""text"">1000000=TRUE"
                    .FormatConditions(.FormatConditions.Count).SetFirstPriority
                    .FormatConditions(1).StopIfTrue = True
                End With
            End With
                
            xlsobj.ActiveWorkbook.Save
                            
            xlsobj.Quit
        
        StartTime = DateAdd("s", 2, Now())
            Do While Now() < StartTime
                DoEvents
            Loop
            
        Application.FollowHyperlink strFolder & "\" & strFile
                                        
            Set xlsobj = Nothing
            Set wb = Nothing
            Set sheet = Nothing
            
DoCmd.Hourglass False
DoCmd.SetWarnings True
            
 End Sub

现在，在对我的范围使用“with”语句时，我收到 1004 错误。我将不胜感激任何帮助推动我朝着正确的方向前进，以使代码按预期使用几个条件格式规则工作，因为我不确定如何最好地从 Excel 的宏记录器中实现代码。

谢谢！

标签： excelvbams-access