Good afternoon folks,
I'm hoping someone can help me as I'm stuck on how to write code to create additional worksheets within an Active workbook.
Below is the code I've produced with the help of this forum and the code works fine, but I want to be able to add in additional worksheets to the active workbook add in the data and format it in the same way I have in my code below. I intend to add a further 28 worksheets within the active workbook. Any assistance/pointers would be most appreciated.
regards
John
I'm hoping someone can help me as I'm stuck on how to write code to create additional worksheets within an Active workbook.
Below is the code I've produced with the help of this forum and the code works fine, but I want to be able to add in additional worksheets to the active workbook add in the data and format it in the same way I have in my code below. I intend to add a further 28 worksheets within the active workbook. Any assistance/pointers would be most appreciated.
Code:
Dim ExcelFile As String
Dim ExcelWorksheet As String
Dim QUESDB As String
Dim QueryName As String
Dim objDB As Database
Dim MyDate As Date
Dim StdDGCount
MyDate = Date
StdDGCount = DCount("*", "qryStdDGQuesResponseStatsExportToExcel")
If StdDGCount > 0 Then
ExcelFile = "M:\Customer Satisfaction\Standard D & G\Monthly Reports\ME" & "_" & Format(Date, "ddmmyy") & ".xls"
ExcelWorksheet = "ME " & Format(Date, "ddmmyy")
QUESDB = "H:\John Lee\Questionnaires.mdb"
QueryName = "qryStdDGQuesReponseStatsExportToExcel"
Set objDB = OpenDatabase(QUESDB)
If Dir(ExcelFile) <> "" Then Kill ExcelFile
'Excute the creation of the Excel file
objDB.Execute "Select*Into[Excel 8.0;Database=" & ExcelFile & "].[" & ExcelWorksheet & "] From " & "[" & QueryName & "]"
objDB.Close
Set objDB = Nothing
Dim ObjExcel As Object
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks.Open "M:\Customer Satisfaction\Standard D & G\Monthly Reports\ME" & "_" & Format(Date, "ddmmyy") & ".xls"
Set objsheet = ObjExcel.ActiveWorkbook.Worksheets(1)
With objsheet
.Rows("1:1").Font.Bold = True
.Rows("1:1").Font.Underline = xlUnderlineStyleSingle
.Rows("1:1").Select
ObjExcel.Selection.Insert Shift:=xlDown
ObjExcel.Range("A1").Select
ObjExcel.ActiveCell.FormulaR1C1 = "Std D&G"
ObjExcel.Range("B1").Select
ObjExcel.ActiveCell.FormulaR1C1 = "Month Ending:"
ObjExcel.Range("D1").Select
ObjExcel.ActiveCell.FormulaR1C1 = MyDate
With ObjExcel.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
.Columns("A:CO").Select
.Columns("A:CO").EntireColumn.AutoFit
ObjExcel.Range("A2:CO31").Select
With ObjExcel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ObjExcel.Range("A2:CO2").Select
With ObjExcel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ObjExcel.Range("A2:CO32").Select
With ObjExcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
ObjExcel.Range("a32:CO32").Select
With ObjExcel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With ObjExcel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlMedium
ColorIndex = xlAutomatic
End With
ObjExcel.Range("A32").Select
ActiveCell.FormulaR1C1 = "=Sum(R[-29]C:R[-1]C)"
ObjExcel.Range("A32").Select
ObjExcel.Selection.AutoFill Destination:=Range("A32:CN32"), Type:=xlFillDefault
ObjExcel.Range("A32:CN32").Select
ObjExcel.Range("A32:CN32").Select
ObjExcel.Selection.Font.Bold = True
ObjExcel.Selection.Font.ColorIndex = 3
End With
ObjExcel.ActiveWorkbook.Close True 'Close the Active Workbook
ObjExcel.Quit 'Close the Excel Application
End Ifregards
John
