Advertisement

06.05.2008 at 06:23AM PDT, ID: 23460035
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.6

Excel automation - total column

Asked by cmccurdy in Microsoft Access Database, Access Coding/Macros

I need to create a total cell at the end of the column in an excel spreadsheet I'm creating using excel automation to output data from a query.  The export works perfectly but I have no clue on how to tell it to total the Balance Due column in the exported spreadsheet.  I'm attaching the code used to create the spreadsheet. Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:

Private Sub MakeExcelFile(TabName As String, rptCriteria As String)
  Dim T As Integer, f As Integer, q As Integer, rsCount As Integer, fillcount As Integer
  Dim db As Database, rs As Recordset, strSQL As String, ROStatusQuery As QueryDef
  Dim xl As Excel.Application, xlWorkSheet As Worksheet, xlWorkBook As Workbook
  Dim tabArray As Variant, qryArray As Variant
  Dim zCol As String, zRow As Integer, FileName As String, vStartRow As Integer, vEndRow As Integer
  Dim qd As QueryDef
   
   On Error GoTo MakeExcelFile_Err
   CurrentDb.QueryDefs.Delete "ROStatusQuery"
    strSQL = "SELECT RO, DueOut, [tbl_Vehicles]![Make] & ' ' & [tbl_Vehicles]![Model] & ' (' & Right([tbl_Vehicles]![Year],2) & ')' AS Vehicle," _
            & " tbl_Customers!ContactFirstName+' '+tbl_Customers!ContactLastName AS Customer," _
            & " IIf(IsNull([DateCompleted]),[DateReceived],[DateCompleted]) AS StatusDate," _
            & " RO_Total, RO_Paid, [RO_Total]-[RO_Paid] AS Balance,tbl_Employees.FirstName as Tech, Issues AS Notes, Problem" _
            & " FROM (((tbl_Vehicles RIGHT JOIN tbl_RepairOrders ON tbl_Vehicles.VehicleID = tbl_RepairOrders.VehicleID)" _
            & " LEFT JOIN tbl_Customers ON tbl_RepairOrders.CustomerID = tbl_Customers.CustomerID)" _
            & " LEFT JOIN tbl_ROStatus ON tbl_RepairOrders.ROStatus = tbl_ROStatus.StatusID) " _
            & " LEFT JOIN tbl_Employees ON tbl_RepairOrders.TechAssigned = tbl_Employees.EmployeeID " _
            & " WHERE " & rptCriteria & " ORDER BY RO DESC;"
    
    Call CurrentDb.CreateQueryDef("ROStatusQuery", strSQL)
    
    
    DoCmd.Hourglass True
    'names of the tabs and associated queries for the workbook
    qryArray = Array("ROStatusQuery")
    tabArray = Array(TabName)
    ' excel worksheets alway fill from this line down
    vStartRow = 2
     ' get the workbook going
    Set xl = New Excel.Application
    xl.Application.Visible = False
    xl.Application.WindowState = xlNormal
    'xl.Application.Visible = True
    xl.DisplayAlerts = False
    Set xlWorkBook = xl.Application.Workbooks.Add
 
    ' Loop through worksheets and rename them
    For T = 0 To UBound(tabArray)
        If T + 1 > xlWorkBook.Worksheets.Count Then
            xlWorkBook.Worksheets.Add After:=xlWorkBook.Worksheets(T)
        End If
        Set xlWorkSheet = xlWorkBook.Worksheets(T + 1)
        xlWorkSheet.Name = tabArray(T)
    Next T
 
' Get the data
 Set db = CurrentDb
 
 For T = UBound(tabArray) To 0 Step -1
    Set xlWorkSheet = xlWorkBook.Worksheets(tabArray(T))
    xl.Application.GoTo Reference:=xlWorkSheet.Range("A1"), scroll:=True
    If T >= 0 Then
      Set rs = db.OpenRecordset(qryArray(T), dbOpenDynaset)
      If Not (rs.BOF And rs.EOF) Then
        rs.MoveLast
        rsCount = rs.RecordCount
      Else
        rsCount = 0
      End If
    End If
           
    For f = 0 To rs.Fields.Count - 1
        zCol = ColumnToLetter(f + 1)
        xlWorkSheet.Range(zCol & "1") = rs.Fields(f).Name
    Next f
    xlWorkSheet.Range(vStartRow & ":" & (vStartRow + rsCount)).EntireRow.RowHeight = 12
    
    If Not (rs.BOF And rs.EOF) Then
        'Add Records to Spreadsheet
        rs.MoveFirst
        xlWorkSheet.Range("A2").CopyFromRecordset rs
    End If
Next T
        
    'Format the spreadsheet
    xlWorkSheet.Range("A:" & zCol).EntireColumn.Font.Name = "Tahoma"
    xlWorkSheet.Range("A:" & zCol).EntireColumn.Font.Size = 8
    xlWorkSheet.Range("A:" & zCol).WrapText = False
    xlWorkSheet.Range("A:" & zCol).EntireColumn.AutoFit
    xlWorkSheet.Range("A:" & zCol).EntireColumn.VerticalAlignment = xlCenter
    xlWorkSheet.Columns.AutoFit
    xlWorkSheet.Rows.AutoFit
    xlWorkSheet.Columns(3).ColumnWidth = 20 'Vehicle
    xlWorkSheet.Columns(4).ColumnWidth = 16 'Customer
    xlWorkSheet.Columns(9).ColumnWidth = 7  'Tech
    xlWorkSheet.Columns(10).ColumnWidth = 40 'Notes
    xlWorkSheet.Columns(10).ColumnWidth = 40 'Problem
    xlWorkSheet.Columns(10).WrapText = True
    xlWorkSheet.Columns(9).HorizontalAlignment = xlCenter
    xlWorkSheet.Columns(6).NumberFormat = "#,##0.00"
    xlWorkSheet.Columns(7).NumberFormat = "#,##0.00"
    xlWorkSheet.Columns(8).NumberFormat = "#,##0.00"
    xlWorkSheet.Columns(9).VerticalAlignment = xlCenter
    xlWorkSheet.Cells(1, 6).Value = "Total"
    xlWorkSheet.Cells(1, 7).Value = "Paid"
    xlWorkSheet.Cells(1, 9).Value = "Tech"
    'xlWorkSheet.Cells(1, 10).Value = "Notes"
    xlWorkSheet.Rows("1:1").Font.Bold = True
    xlWorkSheet.Rows("1:1").HorizontalAlignment = xlCenter
    xlWorkSheet.Rows("1:1").Interior.Color = 16777164
 'Set margins, headers, footers, landscape
   With xlWorkSheet.PageSetup
        .PrintArea = ""
        .Orientation = xlLandscape
        .LeftFooter = "&8 " & TabName & "Repair Orders as of &D"
        .RightFooter = "&8 & Page &P of &N"
        .LeftMargin = 0.25
        .RightMargin = 0.25
        .TopMargin = 0.25
        .BottomMargin = 0.25
        .FooterMargin = 14
        .PrintTitleRows = xlWorkBook.ActiveSheet.Range("A1:A1").Address
        .PrintGridlines = True
        .Zoom = 100
    End With
 
  
MakeExcelFile_Exit:
  
  'Save the file to the user's desktop
  FileName = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & TabName & ".xls"
    
  'Delete the file if it already exists
  If IsFile(FileName) Then
      Kill (FileName)
  End If
  
  xlWorkBook.SaveAs FileName
  
  'Clean up
  xlWorkBook.Close
  xl.Application.DisplayAlerts = True
  xl.Application.Quit
  Set xlWorkSheet = Nothing
  Set xlWorkBook = Nothing
  Set xl = Nothing
  
  'Notify the user
  DoCmd.Hourglass (False)
  MsgBox ("Export completed.  File is " & FileName)
  
  Exit Sub
 
MakeExcelFile_Err:
    MsgBox Err.Description
    Resume MakeExcelFile_Exit
 
End Sub
 
Keywords: Excel automation - total column
Title
1 Excel Automation
2 Automation error help
3 Cell Split
4 Complete Excel automation reference?
5 Automate Date Entry for Range
6 correlating lists (I think)
 
Loading Advertisement...
 
[+][-]06.05.2008 at 06:56AM PDT, ID: 21719400

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Microsoft Access Database, Access Coding/Macros
Sign Up Now!
Solution Provided By: jmoss111
Participating Experts: 2
Solution Grade: A
 
 
[+][-]06.05.2008 at 07:20AM PDT, ID: 21719738

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]06.06.2008 at 03:24PM PDT, ID: 21733136

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.17.2008 at 11:15AM PDT, ID: 21805850

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]06.17.2008 at 02:07PM PDT, ID: 21807501

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20081112-EE-VQP-42 / EE_QW_2_20070628