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的工作表上選擇一個範圍 –