Code for updating cells in an Excel spreadsheet

Hi all

Anyone throw me a snippet or link to some code that examples populating cells in an Excel spreadsheet? I have (or will have) a template spreadsheet that will be filled programmatically from within Access 2000 ... Just wanted a little primer on do it ... Thanks.

- Mike

A long old sub I wrote a while back, has a lot of Excel stuff in it.

Code:

---


Private Sub ExportDetailToExcel(SQLString As String)


Dim XLApp As Excel.Application
Dim XLBook As Excel.Workbook
Dim XLSheet As Excel.Worksheet

Dim intCol As Integer

Dim lngRow As Long
Dim lngUseFlag As Long
Dim lngOpFlag As Long
Dim lngJVFlag As Long
Dim lngTypeFlag As Long

Dim strFileName As String
Dim strUse As String
Dim strType As String
Dim strJV As String
Dim strOp As String

Dim fld As Field

Dim OutputFile As clsDialogs

  Set rs = New ADODB.Recordset
  rs.Open SQLString, db.SecureConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
 
  Set XLApp = New Excel.Application
  Set XLBook = XLApp.Workbooks.Add
  Set XLSheet = XLBook.ActiveSheet
 
  intCol = 1
  lngRow = 1
   
  For Each fld In rs.Fields
 
    XLSheet.Cells(lngRow, intCol) = fld.Name
    intCol = intCol + 1
   
  Next fld
 
  intCol = 1
  lngRow = 2
 
  lngOpFlag = 2
  lngUseFlag = 2
  lngJVFlag = 2
  lngTypeFlag = 2
 
  strUse = rs!ZBTrafficUse
  strType = rs!CHRType
  strJV = rs!Venture
  strOp = rs!CHROpname
 
  Do While Not rs.EOF

    For Each fld In rs.Fields
   
      XLSheet.Cells(lngRow, intCol) = fld.Value
      intCol = intCol + 1
     
    Next fld
   
    intCol = 1
    lngRow = lngRow + 1
         
    rs.MoveNext
     
    If Not rs.EOF Then
   
      If (rs!ZBTrafficUse <> strUse) Or (rs!CHRType <> strType) _
        Or (rs!Venture <> strJV) Or (rs!CHROpname <> strOp) Then
     
        XLSheet.Cells(lngRow, 6) = "Total " & strUse
        XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngUseFlag & ")"
        XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngUseFlag & ")"
        XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngUseFlag & ")"
                     
        XLApp.Range("F" & lngRow, "J" & lngRow).Select
        XLApp.Selection.Interior.ColorIndex = 43
        XLApp.Selection.Interior.Pattern = xlSolid
       
        lngRow = lngRow + 1
       
        lngUseFlag = lngRow
             
        strUse = rs!ZBTrafficUse
     
      End If
           
      If rs!Venture <> strJV Then
             
        XLSheet.Cells(lngRow, 3) = "Total " & strJV
        XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngJVFlag & ")"
        XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngJVFlag & ")"
        XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngJVFlag & ")"
                     
        XLApp.Range("C" & lngRow, "J" & lngRow).Select
        XLApp.Selection.Interior.ColorIndex = 40
        XLApp.Selection.Interior.Pattern = xlSolid
                     
        lngRow = lngRow + 1
       
        lngUseFlag = lngRow
        lngJVFlag = lngRow
       
        strJV = rs!Venture
               
      End If
     
      If rs!CHRType <> strType Then
     
        XLSheet.Cells(lngRow, 2) = "Total " & strType
        XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngTypeFlag & ")"
        XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngTypeFlag & ")"
        XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngTypeFlag & ")"
               
        XLApp.Range("B" & lngRow, "J" & lngRow).Select
        XLApp.Selection.Interior.ColorIndex = 37
        XLApp.Selection.Interior.Pattern = xlSolid
               
        lngRow = lngRow + 1
       
        lngUseFlag = lngRow
        lngJVFlag = lngRow
        lngTypeFlag = lngRow
           
        strType = rs!CHRType
             
      End If
     
      If rs!CHROpname <> strOp Then
           
        XLSheet.Cells(lngRow, 1) = "Total " & strOp
        XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngOpFlag & ")"
        XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngOpFlag & ")"
        XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngOpFlag & ")"
       
        XLApp.Range("A" & lngRow, "J" & lngRow).Select
        XLApp.Selection.Interior.ColorIndex = 35
        XLApp.Selection.Interior.Pattern = xlSolid
       
        lngRow = lngRow + 1
       
        lngUseFlag = lngRow
        lngJVFlag = lngRow
        lngTypeFlag = lngRow
        lngOpFlag = lngRow
                   
        strOp = rs!CHROpname
             
      End If
               
    End If
               
  Loop
 
  XLSheet.Cells(lngRow, 6) = "Total " & strUse
  XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngUseFlag & ")"
  XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngUseFlag & ")"
  XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngUseFlag & ")"
               
  XLApp.Range("F" & lngRow, "J" & lngRow).Select
  XLApp.Selection.Interior.ColorIndex = 43
  XLApp.Selection.Interior.Pattern = xlSolid
 
  lngRow = lngRow + 1
 
  XLSheet.Cells(lngRow, 3) = "Total " & strJV
  XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngJVFlag & ")"
  XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngJVFlag & ")"
  XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngJVFlag & ")"
               
  XLApp.Range("C" & lngRow, "J" & lngRow).Select
  XLApp.Selection.Interior.ColorIndex = 40
  XLApp.Selection.Interior.Pattern = xlSolid
 
  lngRow = lngRow + 1
 
  XLSheet.Cells(lngRow, 2) = "Total " & strType
  XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngTypeFlag & ")"
  XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngTypeFlag & ")"
  XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngTypeFlag & ")"
         
  XLApp.Range("B" & lngRow, "J" & lngRow).Select
  XLApp.Selection.Interior.ColorIndex = 37
  XLApp.Selection.Interior.Pattern = xlSolid
         
  lngRow = lngRow + 1
 
  XLSheet.Cells(lngRow, 1) = "Total " & strOp
  XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H" & lngOpFlag & ")"
  XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I" & lngOpFlag & ")"
  XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J" & lngOpFlag & ")"
 
  XLApp.Range("A" & lngRow, "J" & lngRow).Select
  XLApp.Selection.Interior.ColorIndex = 35
  XLApp.Selection.Interior.Pattern = xlSolid
 
  lngRow = lngRow + 2
 
  XLSheet.Cells(lngRow, 1) = "Report Totals "
  XLSheet.Cells(lngRow, 8) = "=subtotal(9,H" & lngRow - 1 & ":H2)"
  XLSheet.Cells(lngRow, 9) = "=subtotal(9,I" & lngRow - 1 & ":I2)"
  XLSheet.Cells(lngRow, 10) = "=subtotal(9,J" & lngRow - 1 & ":J2)"
     
  XLApp.Range("A" & lngRow, "J" & lngRow).Select
  XLApp.Selection.Interior.ColorIndex = 15
  XLApp.Selection.Interior.Pattern = xlSolid
     
  XLApp.Selection.Font.Bold = True
 
  With XLApp.Selection.Borders(xlEdgeTop)
 
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
   
  End With
       
  With XLApp.Selection.Borders(xlEdgeBottom)
 
    .LineStyle = xlDouble
    .Weight = xlThick
    .ColorIndex = xlAutomatic
   
  End With
 
  XLApp.Range("A1:K1").Select
  XLApp.Selection.Font.Bold = True
 
  XLApp.Columns("A:K").EntireColumn.AutoFit
       
  XLApp.Range("A1", "J" & lngRow).Select
  XLApp.Selection.NumberFormat = "$#,##0.00"
 
  XLApp.Range("K1", "K" & lngRow).Select
  XLApp.Selection.NumberFormat = "0.0000"
 
  XLApp.Range("A1").Select

  Set OutputFile = New clsDialogs
  OutputFile.DialogTitle = "Please Save Output Data"
  OutputFile.ShowSave
  strFileName = OutputFile.FileName
 
  If Not IsNothing(strFileName) Then XLSheet.SaveAs strFileName
 
  Set OutputFile = Nothing
 
  rs.Close
  Set rs = Nothing
         
  MsgBox "Output successful", vbInformation, "Process Complete"
 
  XLApp.Quit
  Set XLSheet = Nothing
  Set XLBook = Nothing
  Set XLApp = Nothing
  Exit Sub

---

Hope that helps

Granty,

Thanks for the code!!!!

- Mike