Here is a VBS Script that does exactly that.

Oh, and another tweak to the original macro. If you change

Set S = ThisWorkbook.ActiveSheet

to

Set S = ActiveSheet

you can store it in your PERSONAL.xls and use it in any workbook without pasting the code in everytime.

Here's the afore mentioned (and afore posted, albeit in a different thread) VB script

Dim connectionString

'The connection string goes here

connectionString = "Provider = SQLOLEDB;Data Source=SERVER_NAME;" & _

"Trusted_Connection=Yes;Initial Catalog=Northwind;"

Dim Query

' The query goes here

Query = "SELECT CompanyName, count(o.CustomerID) as Total" & vbCrLf & _

"FROM Northwind.dbo.Orders o" & vbCrLf & _

"Inner Join Northwind.dbo.Customers c on o.CustomerID = c.CustomerID" & vbCrLf & _

"Group by CompanyName"

Const adOpenStatic = 3

Const adLockOptimistic = 3

Dim i

const xlColumnClustered = 51

const xl3DColumnClustered = 54

const xl3DColumn = -4100

const xlBarClustered = 57

const xl3DBarClustered = 60

const xlLineMarkers = 65

const xl3DLine = -4101

const xlPie = 5

const xlPieExploded = 69

const xl3DPie = -4102

const xl3DPieExploded = 70

const xlArea = 1

const xl3DArea = -4098

const xlSurface = 83

const xlCylinderColClustered = 92

const xlCylinderBarClustered = 95

const xlConeColClustered = 99

const xlConeBarClustered = 102

const xlPyramidBarClustered = 109

const xlPyramidColClustered = 106

Set objConnection = CreateObject("ADODB.Connection")

Set objRecordSet = CreateObject("ADODB.Recordset")

objConnection.Open connectionString

' creating the Excel object application

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.ScreenUpdating = False

Set objWorkbook = objExcel.Workbooks.Add()

Set objWorksheet = objWorkbook.Worksheets(1)

'msgBox Query

objRecordSet.Open Query , objConnection, adOpenStatic, adLockOptimistic

i = 1

objRecordSet.MoveFirst

Do Until objRecordset.EOF

i = i + 1

' This is setting the column names, font, colors, etc.

' This code can be simplified by ranging if desired.

objExcel.Cells(1, 1).Value = "Company Name"

objExcel.Cells(1, 1).Font.Size = 10

objExcel.Cells(1, 1).Font.Bold = TRUE

objExcel.Cells(1, 1).Interior.ColorIndex = 6

objExcel.Cells(1, 2).Value = "Total"

objExcel.Cells(1, 2).Font.Size = 10

objExcel.Cells(1, 2).Font.Bold = TRUE

objExcel.Cells(1, 2).Interior.ColorIndex = 6

' Now we are getting the data and highlighting certain columns

objExcel.Cells(i, 1).Value = objRecordset.Fields.Item("CompanyName")

objExcel.Cells(i, 1).Font.Size = 10

objExcel.Cells(i, 1).Borders.LineStyle = True

objExcel.Cells(i, 2).Value = objRecordset.Fields.Item("Total")

objExcel.Cells(i, 2).Font.Size = 10

objExcel.Cells(i, 2).Borders.LineStyle = True

objRecordset.MoveNext

objExcel.Range("A1:B1").Borders.LineStyle = True

Loop

' automatically fits the data to the columns

Set objRange = objWorksheet.UsedRange

objRange.EntireColumn.Autofit()

'Create a chart

objRange.Activate

objWorkbook.Charts.Add

objWorkbook.ActiveChart.ChartType = xlCylinderColClustered

objWorkbook.ActiveChart.SetSourceData objRange, 1

objWorkbook.ActiveChart.Location 2, "Sheet1"

objExcel.ScreenUpdating = True

' cleaning up

objRecordSet.Close

objConnection.Close