Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Repost! Excel multiple worksheet populate from recordset
Using Access2000, the sample code below is what I have been modifying and
working on since the past week and I could not get it to work properly. What I wanted to accomplish: 1) read from a recordset and export to Excel 2) Excel is populated based from an ID (may possible be one or multiple) and renames the worksheet based from the ID 3) the code also format the fields The sample database may be downloaded at: http://www.geocities.com/mgtulips/sample_db.mdb TIA! Bob Dim db As Database 'used to reference the current database Dim rs As Recordset, rsID As Recordset Dim qDef As QueryDef Dim xlApp As Object, wkb As Object, wks As Object Dim sCarrier As String, sMPC As String Dim i As Integer, intSPID As Integer Dim strSQL As String, strSQL2 As String Dim iWorksheets As Integer, x As Integer Set db = CurrentDb() 'initialize the database variable to this database Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Set rsID = db.OpenRecordset("qryID", dbOpenDynaset) Set wkb = xlApp.Workbooks.Add iWorksheets = DCount("*", "qryID") Set wks = wkb.ActiveSheet Do While Not rsID.EOF For x = 1 To iWorksheets 'Go to Next Worksheet Worksheets(x).Activate strSQL2 = "SELECT rank, desc, inv_current, inv_previous, inv_variance," strSQL2 = strSQL2 & " ytd_current, ytd_previous, ytd_variance," strSQL2 = strSQL2 & " market_share_current, market_share_previous, share_vs_ly" strSQL2 = strSQL2 & " FROM tmp_result_all" strSQL2 = strSQL2 & " WHERE id = '" & rsID("id").Value & "'" Set rs = db.OpenRecordset(strSQL2, dbOpenDynaset) 'format the excel report wks.Range("A1:A3").Font.Bold = True wks.Range("A1:A3").Font.Size = 10 wks.Range("A1:A3").Font.Color = RGB(255, 0, 0) wks.Range("A1:A3").HorizontalAlignment = xlLeft wks.Range("A5:K5").Font.Bold = True wks.Range("A5:K5").Font.Size = 10 wks.Range("A5:K5").Font.Name = "Arial" wks.Range("A5:K5").Interior.ColorIndex = 15 wks.Range("A5:K5").WrapText = True wks.Range("A5:K5").HorizontalAlignment = xlCenter wks.Range("A5:A60").HorizontalAlignment = xlCenter wks.Range("E5:E60").HorizontalAlignment = xlCenter wks.Range("H5:K60").HorizontalAlignment = xlCenter wks.Range("B57:K57").Font.Bold = True wks.Rows(5).RowHeight = 35 'wks.Range("B4:B55").HorizontalAlignment = xlLeft 'wks.Range("D:E").HorizontalAlignment = xlCenter 'rank wks.Range("A5:A60").ColumnWidth = 15 'airline wks.Range("B5:B60").ColumnWidth = 30 'sales wks.Range("C5:E60").ColumnWidth = 13 'ytd_current wks.Range("F5:F60").ColumnWidth = 12 'ytd_previous, ytd_variance wks.Range("G5:I60").ColumnWidth = 13 wks.Range("A1").Value = "Test1" wks.Range("A2").Value = "Test2" wks.Range("A3").Value = "Test3" wks.Range("A5").Value = "RANK" wks.Range("B5").Value = "DESC" wks.Range("C5").Value = "INV CURRENT" wks.Range("D5").Value = "INV PREVIOUS" wks.Range("E5").Value = "INV VARIANCE" wks.Range("F5").Value = "YTD CURRENT" wks.Range("G5").Value = "YTD PREVIOUS" wks.Range("H5").Value = "YTD VARIANCE" wks.Range("I5").Value = "MARKET SHARE CURRENT" wks.Range("J5").Value = "MARKET SHARE PREVIOUS" wks.Range("K5").Value = "SHARE VS LY" wks.Range("A1").NumberFormat = "mmm-yy" wks.Range("C6:D60").NumberFormat = "#,##0_);-#,##0" wks.Range("E6:E60").NumberFormat = "#,##0.00%_);-#,##0.00%" wks.Range("F6:G60").NumberFormat = "#,##0_);-#,##0" wks.Range("E6:E60").NumberFormat = "#,##0%_);-#,##0%" wks.Range("H6:H60").NumberFormat = "#,##0%_);-#,##0%" wks.Range("I6:J60").NumberFormat = "#,##0.0%_);-#,##0.0%" wks.Range("K6:K60").NumberFormat = "#,##0%_);-#,##0%" wks.Range("A6").CopyFromRecordset rs 'insert columns Columns("C:C").Select Selection.Insert Shift:=xlToRight wks.Range("C:C").ColumnWidth = 0.5 Columns("G:G").Select Selection.Insert Shift:=xlToRight wks.Range("G:G").ColumnWidth = 0.5 Columns("K:K").Select Selection.Insert Shift:=xlToRight wks.Range("K:K").ColumnWidth = 0.5 Rows(57).EntireRow.Insert Range("B58:N58").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = xlAutomatic End With Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone 'delete 51 & 52 number description from RANK field in Excel wks.Range("A56:A58").Value = "" wks.Name = rsID("id").Value rsID.MoveNext Next x Loop rs.Close rsID.Close Set rs = Nothing Set rsID = Nothing Set qDef = Nothing Set wkb = Nothing Set wks = Nothing Set xlApp = Nothing Set db = Nothing |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Repost! Excel multiple worksheet populate from recordset
B.
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Populate central worksheet template from multiple worksheets | Excel Discussion (Misc queries) | |||
Lookup list from different worksheet & auto-populate multiple cell | Excel Discussion (Misc queries) | |||
getting multiple data to populate another worksheet | Excel Worksheet Functions | |||
Help! Excel multiple worksheet populate from recordset | Excel Programming | |||
How to populate a multi-column activeX listbox on a spreadsheet with an ADO recordset | Excel Programming |