0
我一直在为此工作数天，并在互联网上阅读了如此多的内容，现在我已经失明，并且没有剩余头发。非常接近解决方案，但非常需要帮助。通过Access VBA导出并格式化Excel - .Range错误
我有一个Access数据库，我做了一些查询从表中检索数据。我用一个按钮创建了一个表单，用多张表单将其导出到Excel。
我想导出格式并查看如何完成我将宏转换为Vb，我看到它是如何完成的但我不能让代码创建多张工作簿并添加一些条件格式到列F.
，将导出到Excel与访问表格式的代码看起来是这样的：
Private Sub Advance_Waiting_on_Visual_Report_Click()
On Error GoTo Advance_Waiting_on_Visual_Report_Click_Err
Const FileNameBase As String = "W:\Quality-Projects\RCabler\Databases\Weekly Reports\Waiting on Visual Weekly Report [CurrentDate].xlsx"
Dim strFileName As String
strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
DoCmd.OutputTo acOutputQuery, "AdvanceWaitVis", "ExcelWorkbook(*.xlsx)", strFileName, True, "AdvanceWaitVis", , acExportQualityPrint
Advance_Waiting_on_Visual_Report_Click_Exit:
Exit Sub
Advance_Waiting_on_Visual_Report_Click_Err:
MsgBox Error$
Resume Advance_Waiting_on_Visual_Report_Click_Exit
End Sub`
这将数据导出到Excel与Access表的格式，但我不知道如何给它添加使其通过调用其他查询来完成多个工作表，也不会有条件地格式化F列以使单元格在日期i之前变为红色年龄在14岁或以上。
此代码将导出到Excel中有多个表，但它不传输Access表格式和挂就行了
.Range("F1:F" & lngRow).Select
正因为如此挂不设置在代码中列出的条件格式在那之后。
Code in Module named ExportFormatting
Public Function fnLastRow(sh As Object)
On Error Resume Next
With sh
fnLastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=2, _
LookIn:=5, _
SearchOrder:=1, _
SearchDirection:=2, _
MatchCase:=False).row
End With
End Function
Code for button
Private Sub Command35_Click()
Const FileNameBase As String = "W:\Quality-Projects\RCabler\Databases\Weekly Reports\Waiting on Visual Weekly Report [CurrentDate].xlsx"
Dim strFileName As String
strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "AdvanceWaitVis", strFileName, True, "AdvanceWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "ArcadiaWaitVis", strFileName, True, "ArcadiaWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "EcruWaitVis", strFileName, True, "EcruWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "LeesportWaitVis", strFileName, True, "LeesportWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "RipleyWaitVis", strFileName, True, "RipleyWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanekWaitVis", strFileName, True, "WanekWaitVis"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanvogWaitVis", strFileName, True, "WanvogWaitVis"
Dim xlWB As Object
Dim xlObj As Object
Dim xlSheet As Object
Dim lngRow As Long
Set xlObj = CreateObject("Excel.Application")
Set xlWB = xlObj.Workbooks.Open(strFileName, False, False)
For Each xlSheet In xlWB.Worksheets
With xlSheet
lngRow = fnLastRow(xlSheet)
Debug.Print lngRow
.Range("F1:F" & lngRow).Select
xlObj.Selection.FormatConditions.Add Type:=2, Formula1:= _
"=TODAY()-F1<13"
xlObj.Selection.FormatConditions(xlObj.Selection.FormatConditions.Count).SetFirstPriority
With xlObj.Selection.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 255
.TintAndShade = 0
End With
xlObj.Selection.FormatConditions(1).StopIfTrue = False
End With
Next
xlWB.Close True
Set xlSheet = Nothing
Set xlWB = Nothing
xlObj.Quit
Set xlObj = Nothing
End Sub
有人可以帮我解决这个问题吗？
我明白在上面的代码中有2个不同的按钮名称......这是因为我有2个不同的按钮尝试不同的事情来实现这个功能。我需要的代码可以是第一个或第二个......我只需要能够将格式导出到具有多个工作表的一个工作簿并有条件地格式化F列，以便在日期值为14天之前填充单元格或者年长......如果空白或少于14天，则什么都不做。提前感谢任何愿意帮助的人。 – PsyC0TiC1
您不能在不是ActiveSheet的工作表上选择一个范围 –