Set S = ThisWorkbook.ActiveSheet

Set S = ActiveSheet

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