VB icon

Build 3D chart in Excel from 3D array

Email
Submitted on: 1/26/2015 8:32:00 AM
By: Oliver French (from psc cd)  
Level: Intermediate
User Rating: By 13 Users
Compatibility: VB 4.0 (32-bit), VB 5.0, VB 6.0, VBA MS Excel
Views: 8411
 
     This function takes a three dimensional array of data with four parameters to track trends as they vary along two variables, opens a new instance of Excel, enters the data in three Excel worksheets, then creates charts of one of the data sets. One chart is a three dimensional surface type. In this case, it was desired to show the Q of an inductive winding at differing frequencies and with a metal target at varying distances from the winding.

 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: Build 3D chart in Excel from 3D array
' Description:This function takes a three dimensional array of data with four parameters to track trends as they vary along two variables, opens a new instance of Excel, enters the data in three Excel worksheets, then creates charts of one of the data sets. One chart is a three dimensional surface type. In this case, it was desired to show the Q of an inductive winding at differing frequencies and with a metal target at varying distances from the winding.
' By: Oliver French (from psc cd)
'
' Inputs:A three dimensional array. In this case, the first dimension is set as [Distance],[Frequency],[Q],[Inductance],and [dQ/dResistance]. The distance parameter varies along the second dimension, and the frequency parameter varies along the third dimension.
'
' Returns:The function does not return any values - error checking should be added to return a boolean indicating if any errors occurred.
'**************************************

' ********************************************************************************
' ********************************************************************************
' **Save and chart a 3D array of data in excel **
' ********************************************************************************
' ********************************************************************************
Public Function Chart3DArray(varData As Variant)
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlQSheet As Excel.Worksheet
Dim xlLSheet As Excel.Worksheet
Dim xlRSheet As Excel.Worksheet
Dim SFile As String
Dim intQStartRow As Integer
Dim intDQStartRow As Integer
Dim intLStartRow As Integer
Dim intRStartRow As Integer
Dim xl3DChart As Excel.Chart
Dim xl2DChart As Excel.Chart
Dim d%, f%
Set xlApp = New Excel.Application' Create new instance of excel
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
' Name sheets
xlBook.Sheets("Sheet1").Name = "Q"
xlBook.Sheets("Sheet2").Name = "L"
xlBook.Sheets("Sheet3").Name = "R"
' Load sheet objects
Set xlQSheet = xlApp.Worksheets("Q")
Set xlLSheet = xlApp.Worksheets("L")
Set xlRSheet = xlApp.Worksheets("R")
' Load start row variables to keep track of which row data is being entered in
intQStartRow = 3
xlQSheet.Cells(intQStartRow - 2, 1) = "Q Data"
intDQStartRow = UBound(varData, 2) + intQStartRow + 4
xlQSheet.Cells(intDQStartRow - 2, 1) = "dQ/dD (Slopes are calculate over 1mm intervals)"
intLStartRow = 3
xlLSheet.Cells(intLStartRow - 2, 1) = "L Data (mHenries)"
intRStartRow = 3
xlRSheet.Cells(intRStartRow - 2, 1) = "R Data (ohms)"
' Populate sheet with data
For d% = 0 To UBound(varData, 2)
xlQSheet.Cells(d% + intQStartRow, 1) = varData(0, d%, 0) & "mm"
xlQSheet.Cells(intDQStartRow + d%, 1) = varData(0, d%, 0) & "mm"
xlLSheet.Cells(d% + intLStartRow, 1) = varData(0, d%, 0) & "mm"
xlRSheet.Cells(d% + intRStartRow, 1) = varData(0, d%, 0) & "mm"
Next d%
For f% = 0 To UBound(varData, 3)
xlQSheet.Cells(intQStartRow - 1, 2 + f%) = varData(1, 0, f%) & "kHz"
xlQSheet.Cells(intDQStartRow - 1, 2 + f%) = varData(1, 0, f%) & "kHz"
xlLSheet.Cells(intLStartRow - 1, 2 + f%) = varData(1, 0, f%) & "kHz"
xlRSheet.Cells(intRStartRow - 1, 2 + f%) = varData(1, 0, f%) & "kHz"
For d% = 0 To UBound(varData, 2)
xlQSheet.Cells(d% + intDQStartRow, 2 + f%) = varData(5, d%, f%)
xlQSheet.Cells(d% + intQStartRow, 2 + f%) = varData(2, d%, f%)
xlLSheet.Cells(d% + intLStartRow, 2 + f%) = varData(3, d%, f%)
xlRSheet.Cells(d% + intRStartRow, 2 + f%) = varData(4, d%, f%)
Next d%
Next f%
' Plot 3d Chart of Q
xlApp.Charts.Add
Set xl3DChart = xlApp.ActiveChart
xl3DChart.SetSourceData Source:=xlBook.Sheets("Q").Range(xlQSheet.Cells(intQStartRow, 1), _
xlQSheet.Cells(intQStartRow + UBound(varData, 2), UBound(varData, 3) + 2)), PlotBy:=xlColumns
For f% = 0 To UBound(varData, 3)
xl3DChart.SeriesCollection(f% + 1).Name = CStr(varData(1, 0, f%)) & " kHz"
Next f%
xl3DChart.Location Where:=xlLocationAsNewSheet, Name:="Q 3D Chart Temp"
With xl3DChart
.HasTitle = True
.ChartTitle.Characters.Text = "Core Analysis"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Characters.Text = "Distance"
.ChartType = xlSurface
.Axes(xlSeries).HasTitle = True
.Axes(xlSeries).AxisTitle.Characters.Text = "Frequency"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = "Q"
End With
' Copy the same chart then change original to x-y scatter with smoothed lines
xlBook.Sheets("Q 3D Chart Temp").Copy Before:=xlBook.Sheets("Q 3D Chart Temp")
xlBook.Sheets("Q 3D Chart Temp (2)").Name = "Q Chart 3D"
xl3DChart.ChartType = xlLineMarkers
With xl3DChart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
xl3DChart.PlotArea.Fill.OneColorGradient Style:=1, Variant:=1, _
Degree:=0.231372549019608
With xl3DChart.PlotArea
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 17
End With
xlBook.Sheets("Q 3D Chart Temp").Name = "2D Q Chart"
' Plot 2d Chart of dQ/dD
xlApp.Charts.Add
Set xl2DChart = xlApp.ActiveChart
xl2DChart.SetSourceData Source:=xlBook.Sheets("Q").Range(xlQSheet.Cells(intDQStartRow, 1), _
xlQSheet.Cells(intDQStartRow + UBound(varData, 2), UBound(varData, 3) + 2)), PlotBy:=xlColumns
For f% = 0 To UBound(varData, 3)
xl2DChart.SeriesCollection(f% + 1).Name = CStr(varData(1, 0, f%)) & " kHz"
Next f%
xl2DChart.Location Where:=xlLocationAsNewSheet, Name:="dQdD Chart"
With xl2DChart
.HasTitle = True
.ChartTitle.Characters.Text = "Core Analysis"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Characters.Text = "Distance"
.ChartType = xlLineMarkers
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = "dQ/dD"
End With
With xl2DChart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
xl2DChart.PlotArea.Fill.OneColorGradient Style:=1, Variant:=1, _
Degree:=0.231372549019608
With xl2DChart.PlotArea
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 17
End With
' Save file
With frmSensorSetup.dlgSave
.DialogTitle = "Save"
.CancelError = False
.Filter = "Excel Workbooks (*.xls)|*.xls"
.ShowSave
If Len(.FileName) = 0 Then
MsgBox "Enter a valid name"
Else
SFile = .FileName
End If
End With
xlBook.SaveAs (SFile)
xlBook.Close
xlApp.Quit
' Clear objects from memory
Set xlQSheet = Nothing
Set xlLSheet = Nothing
Set xlRSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Function


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.