-2
私はAccessからExcelレポートを作成しようとしています。そのかなり大きい。私のマネージャーが望むようにシートを整形するための15個のタブとたくさんのコード行。 問題は大きすぎるので、サブルーチンのいくつかを壊す必要があります。 しかし、私は1つの単一のExcelファイルにデータを追加する2つの別々のサブルーチンを作るように思えます。サブルーチンプロシージャが大きすぎます。それを打ち破る
ここに私のコードの一部があります。あまりにも多くをペーストしてください。 これは最初のシートを作成し、別のシートを追加しています。 私はちょうど同じシートに追加し続け、その完了時にはユーザーのためにポップアップするので、約10シートを追加することができます。
Sub Southwest()
'Southwest
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer
DoCmd.SetWarnings False
DoCmd.Hourglass (True)
' Southwest ***************************************************************************************************
'Early Binding DATA FIRST
Set xlApp = Excel.Application
xlApp.Application.DisplayAlerts = False
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
.Name = "Southwest"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10
End With
'RETRIEVE DATA
'SQL statement
SQL = "SELECT VP, AVP, [Master Project ID], [Master Project Nm], [Budget Entity], Actuals, SORTABS, Forecast, [% Spent], Explanation, Status, [High Range], [Low Range], " & _
"(Actuals - Actuals)/Actuals AS Discount " & _
"FROM ActualsvsForecast " & _
"Where AVP = 'West' " & _
"ORDER BY VP, AVP, [Status] DESC, [SORTABS] DESC, [Master Project ID] "
'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
'BUILD SPREADSHEET
'Create an instance of Excel and start building a spreadsheet
xlApp.Visible = False
intSheets = xlBook.Worksheets.Count
Set xlSheetLast = xlBook.Worksheets(intSheets)
Set xlSheet = xlBook.Worksheets.Add(, xlSheetLast, 1, xlWorksheet)
With xlSheet
.Name = "West"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10
'Set column widths
.Columns("A").ColumnWidth = 1
.Columns("B").ColumnWidth = 12
.Columns("C").ColumnWidth = 12
.Columns("D").ColumnWidth = 17
.Columns("E").ColumnWidth = 50
.Columns("F").ColumnWidth = 17
.Columns("G").ColumnWidth = 17
.Columns("H").ColumnWidth = 17
.Columns("I").ColumnWidth = 17
.Columns("J").ColumnWidth = 17
.Columns("K").ColumnWidth = 17
.Columns("L").ColumnWidth = 50
.Columns("M").ColumnWidth = 8
.Range("A3").Activate
ActiveWindow.FreezePanes = True
'Format columns
.Columns("A").NumberFormat = "@"
.Columns("G").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("H").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("I").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("J").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("K").NumberFormat = "###0.0%;-###0.0%;-"
'build column headings
.Range("A2").Value = ""
.Range("B2").Value = "VP"
.Range("C2").Value = "AVP"
.Range("D2").Value = "Master Project ID"
.Range("E2").Value = "Master Project Name"
.Range("F2").Value = "Budget Entity"
.Range("G2").Value = "Actuals"
.Range("H2").Value = "Forecast"
.Range("I2").Value = "High Range"
.Range("J2").Value = "Low Range"
.Range("K2").Value = "% Spent"
.Range("L2").Value = "Explanation"
.Range("M2").Value = "Status"
'Format Column Headings
.Range("B2:L2").HorizontalAlignment = xlCenter
.Range("B2:L2").Cells.Font.Bold = True
.Range("B2:L2").Interior.Color = RGB(0, 0, 0)
.Range("B2:L2").Font.Color = RGB(255, 255, 255)
'provide initial value to row counter
i = 3
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("B" & i).Value = Nz(rs1!VP, "")
.Range("C" & i).Value = Nz(rs1!AVP, "")
.Range("D" & i).Value = Nz(rs1![Master Project ID], "")
.Range("E" & i).Value = Nz(rs1![Master Project Nm], "")
.Range("F" & i).Value = Nz(rs1![Budget Entity], "")
.Range("G" & i).Value = Nz(rs1!Actuals, 0)
.Range("H" & i).Value = Nz(rs1!Forecast, 0)
.Range("I" & i).Value = Nz(rs1![High Range], 0)
.Range("J" & i).Value = Nz(rs1![Low Range], 0)
.Range("K" & i).Value = Nz(rs1![% Spent], 0)
.Range("L" & i).Value = Nz(rs1!Explanation, "")
.Range("M" & i).Value = Nz(rs1!Status, "")
'Center % [% Spent]
.Range("K" & i).HorizontalAlignment = xlCenter
'Row Height
.Rows(i).RowHeight = 25
i = i + 1
rs1.MoveNext
Loop
'Formulas for total line
'Count items
.Range("B" & i, "E" & i).Merge
.Range("B" & i).Value = "Total"
.Range("B" & i).HorizontalAlignment = xlCenter
'Sum Totals
.Range("G" & i).Formula = "=SUM(G3:G" & i - 1
.Range("H" & i).Formula = "=SUM(H3:H" & i - 1
.Range("I" & i).Formula = "=SUM(I3:I" & i - 1
.Range("J" & i).Formula = "=SUM(J3:J" & i - 1
.Range("A" & i & ":F" & i).Cells.Font.Bold = True
'grid-lines:
ActiveWindow.DisplayGridlines = False
.Range("C3:A" & i).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("B3:D" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("B3:D" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("C3:K" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
.Range("B3:L" & i + 0).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
.Range("C3:L" & i + 0).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("B3:L" & i + 0).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("C3" & i + 0).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
'.Range("L3" & i + 0).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
'Add conditional formatting - only 3 allowed
'With .Range("J3:J" & i).FormatConditions.Add(xlCellValue, xlBetween, 0.05, 0.0499)
'.Interior.Color = RGB(157, 255, 157)
'End With
'With .Range("F3:F" & i).FormatConditions.Add(xlCellValue, xlBetween, 0.05, 0.0999)
' .Interior.Color = RGB(255, 155, 55) 'orange
' End With
'With .Range("D3:L" & i).FormatConditions.Add(xlCellRow, xlEqual, M3 = "RED")
'.Interior.Color = RGB(255, 53, 53) 'red
'End With
'Grid-line: under total line
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
'Total Row Format
.Range("B" & i & ":L" & i).Cells.Font.Size = 12
.Range("B" & i & ":L" & i).Cells.Font.Bold = True
.Range("B" & i & ":L" & i).Interior.Color = RGB(191, 191, 191)
.Rows(i).RowHeight = 25
i = i + -1
.Range("B3", "B" & i).Merge
.Range("B3").VerticalAlignment = xlCenter
.Range("B3").Cells.Font.Bold = True
.Range("C3", "C" & i).Merge
.Range("C3").VerticalAlignment = xlCenter
.Range("C3").Cells.Font.Bold = True
End With
'Andrew ************************************************************************************************************
'RETRIEVE DATA
'SQL statement
SQL = "SELECT VP, AVP, [Master Project ID], [Master Project Nm], [Budget Entity], Actuals, SORTABS, Forecast, [% Spent], Explanation, Status, [High Range], [Low Range], " & _
"(Actuals - Actuals)/Actuals AS Discount " & _
"FROM ActualsvsForecast " & _
"Where AVP = 'Andrew' " & _
"ORDER BY VP, AVP, [Status] DESC, [SORTABS] DESC, [Master Project ID] "
'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'BUILD SPREADSHEET
'Create an instance of Excel and start building a new sheet
'Early Binding
'Set xlApp = Excel.Application
xlApp.Visible = False
'Set xlBook = xlApp.Workbooks.Add
'Set xlSheet = xlBook.Worksheets(1)
intSheets = xlBook.Worksheets.Count
Set xlSheetLast = xlBook.Worksheets(intSheets)
Set xlSheet = xlBook.Worksheets.Add(, xlSheetLast, 1, xlWorksheet)
With xlSheet
.Name = "Andrew"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10
'Set column widths
.Columns("A").ColumnWidth = 1
.Columns("B").ColumnWidth = 12
.Columns("C").ColumnWidth = 12
.Columns("D").ColumnWidth = 17
.Columns("E").ColumnWidth = 50
.Columns("F").ColumnWidth = 17
.Columns("G").ColumnWidth = 17
.Columns("H").ColumnWidth = 17
.Columns("I").ColumnWidth = 17
.Columns("J").ColumnWidth = 17
.Columns("K").ColumnWidth = 17
.Columns("L").ColumnWidth = 50
.Columns("M").ColumnWidth = 8
.Range("A3").Activate
ActiveWindow.FreezePanes = True
'Format columns
.Columns("A").NumberFormat = "@"
.Columns("G").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("H").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("I").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("J").NumberFormat = "$#,##0_);($#,##0);-"
.Columns("K").NumberFormat = "###0.0%;-###0.0%;-"
'build column headings
.Range("A2").Value = ""
.Range("B2").Value = "VP"
.Range("C2").Value = "AVP"
.Range("D2").Value = "Master Project ID"
.Range("E2").Value = "Master Project Name"
.Range("F2").Value = "Budget Entity"
.Range("G2").Value = "Actuals"
.Range("H2").Value = "Forecast"
.Range("I2").Value = "High Range"
.Range("J2").Value = "Low Range"
.Range("K2").Value = "% Spent"
.Range("L2").Value = "Explanation"
.Range("M2").Value = "Status"
'Format Column Headings
.Range("B2:L2").HorizontalAlignment = xlCenter
.Range("B2:L2").Cells.Font.Bold = True
.Range("B2:L2").Interior.Color = RGB(0, 0, 0)
.Range("B2:L2").Font.Color = RGB(255, 255, 255)
'provide initial value to row counter
i = 3
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("B" & i).Value = Nz(rs1!VP, "")
.Range("C" & i).Value = Nz(rs1!AVP, "")
.Range("D" & i).Value = Nz(rs1![Master Project ID], "")
.Range("E" & i).Value = Nz(rs1![Master Project Nm], "")
.Range("F" & i).Value = Nz(rs1![Budget Entity], "")
.Range("G" & i).Value = Nz(rs1!Actuals, 0)
.Range("H" & i).Value = Nz(rs1!Forecast, 0)
.Range("I" & i).Value = Nz(rs1![High Range], 0)
.Range("J" & i).Value = Nz(rs1![Low Range], 0)
.Range("K" & i).Value = Nz(rs1![% Spent], 0)
.Range("L" & i).Value = Nz(rs1!Explanation, "")
.Range("M" & i).Value = Nz(rs1!Status, "")
'Center % [% Spent]
.Range("K" & i).HorizontalAlignment = xlCenter
'Row Height
.Rows(i).RowHeight = 25
i = i + 1
rs1.MoveNext
Loop
'Formulas for total line
'Count items
.Range("B" & i, "E" & i).Merge
.Range("B" & i).Value = "Total"
.Range("B" & i).HorizontalAlignment = xlCenter
'Sum Totals
.Range("G" & i).Formula = "=SUM(G3:G" & i - 1
.Range("H" & i).Formula = "=SUM(H3:H" & i - 1
.Range("I" & i).Formula = "=SUM(I3:I" & i - 1
.Range("J" & i).Formula = "=SUM(J3:J" & i - 1
.Range("A" & i & ":F" & i).Cells.Font.Bold = True
'grid-lines:
ActiveWindow.DisplayGridlines = False
.Range("C3:A" & i).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("B3:D" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("B3:D" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("C3:K" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
.Range("B3:L" & i + 0).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
.Range("C3:L" & i + 0).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("C3:L" & i + 0).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("B3:L" & i + 0).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("C3" & i + 0).Borders(xlEdgeLeft).Weight = XlBorderWeight.xlMedium
'.Range("L3" & i + 0).Borders(xlEdgeRight).Weight = XlBorderWeight.xlMedium
'Add conditional formatting - only 3 allowed
'With .Range("J3:J" & i).FormatConditions.Add(xlCellValue, xlBetween, 0.05, 0.0499)
'.Interior.Color = RGB(157, 255, 157)
'End With
'With .Range("F3:F" & i).FormatConditions.Add(xlCellValue, xlBetween, 0.05, 0.0999)
' .Interior.Color = RGB(255, 155, 55) 'orange
' End With
'With .Range("D3:L" & i).FormatConditions.Add(xlCellRow, xlEqual, M3 = "RED")
'.Interior.Color = RGB(255, 53, 53) 'red
'End With
'Grid-line: under total line
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
.Range("B" & i & ":L" & i).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium
'Total Row Format
.Range("B" & i & ":L" & i).Cells.Font.Size = 12
.Range("B" & i & ":L" & i).Cells.Font.Bold = True
.Range("B" & i & ":L" & i).Interior.Color = RGB(191, 191, 191)
.Rows(i).RowHeight = 25
i = i + -1
.Range("B3", "B" & i).Merge
.Range("B3").VerticalAlignment = xlCenter
.Range("B3").Cells.Font.Bold = True
.Range("C3", "C" & i).Merge
.Range("C3").VerticalAlignment = xlCenter
.Range("C3").Cells.Font.Bold = True
End With
SubExit:
On Error Resume Next
messagebox = "Exit SUB"
DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
DoCmd.SetWarnings True
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
ここでは完全な質問はありません。 – shawnt00
大規模なコードは維持するのは難しいですが、あなたのコードが「大きすぎるためにクラップアウトしている」というあなたの主張について非常に懐疑的です。コードサイズはあなたの問題の1つに過ぎないと思う。 –
エラーはコンパイルエラーです：手順が大きすぎます。 – Robotron