Continue to Site

Welcome to EDAboard.com

Welcome to our site! EDAboard.com is an international Electronics Discussion Forum focused on EDA software, circuits, schematics, books, theory, papers, asic, pld, 8051, DSP, Network, RF, Analog Design, PCB, Service Manuals... and a whole lot more! To participate you need to register. Registration is free. Click here to register now.

VBA Help, Excel 2007 Showing Secondary Axis Title

Status
Not open for further replies.

krixen

Member level 2
Joined
Jul 18, 2011
Messages
43
Helped
4
Reputation
8
Reaction score
4
Trophy points
1,288
Location
Hauppauge, NY
Activity points
1,648
I have created a program to graph data with the primary and secondary y axes and for some reason i cannot get the secondary y axis to show its corresponding title, whereas the primary title works just find. I found that the technique i am using works well with excel 2003 but in 2007 microsoft changed a few techniques and now you have to do it another way but i cannot find it. Any assistance will be much appreciated :] here is my code:

Public Function MakeAGraph( _
ByVal grphName As String, _
ByVal Xaxis As String, _
ByVal Yaxis As String, _
ByVal Y2axis As String, _
ByVal title As String, _
ByRef isChecked() As Boolean, _
ByVal tabNameExtension As String _
) As String

Dim ShtOpt As Worksheet
Set ShtOpt = Sheets("Option")

Dim cht As Chart
Set cht = Nothing

Dim shtCellList As Worksheet
Set shtCellList = Sheets("Color")

Dim rngX As Range
Dim rngY As Range
Dim rngy2 As Range
Dim colX As String
Dim colY As String
Dim ColY2 As String

Set rngX = ShtOpt.Range("A3:A30").Find(Xaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngX Is Nothing) Then
MakeAGraph = "Can't find X-axis: " + Xaxis
Exit Function
End If
colX = rngX.Offset(0, 1)
Dim xAxisTitle As String
xAxisTitle = rngX.Offset(0, 2)




Set rngY = ShtOpt.Range("A3:A30").Find(Yaxis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngY Is Nothing) Then
MakeAGraph = "Can't find Y-axis: " + Yaxis
Exit Function
End If

Set rngy2 = ShtOpt.Range("A3:A30").Find(Y2axis, LookIn:=xlValues, Lookat:=xlWhole)
If (rngy2 Is Nothing) Then

'MakeAGraph = "Can't find Y2-axis: " + Y2axis
' Exit Function
End If

colY = rngY.Offset(0, 1)
Dim yAxisTitle As String
On Error Resume Next
yAxisTitle = rngY.Offset(0, 2)
On Error GoTo 0
If yAxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y-axis title, looking up: " + Yaxis
'Exit Function
End If


If (rngy2 Is Nothing) Then


Else
ColY2 = rngy2.Offset(0, 1)
Dim YA2AxisTitle As String
On Error Resume Next
YA2AxisTitle = rngy2.Offset(0, 2)
On Error GoTo 0
If YA2AxisTitle = "" Then
'MakeAGraph = "Attempting to create graph: " + grphName + ", Can't find Y2-axis title, looking up: " + Y2axis
' Exit Function
End If
End If

Dim legalSheetName As String
legalSheetName = grphName
legalSheetName = Replace(legalSheetName, "[", "")
legalSheetName = Replace(legalSheetName, "]", "")
legalSheetName = Replace(legalSheetName, "*", "")
legalSheetName = Replace(legalSheetName, "?", "")
legalSheetName = Replace(legalSheetName, "/", "")
legalSheetName = Replace(legalSheetName, "\", "")
legalSheetName = Replace(legalSheetName, ".", "")
legalSheetName = Replace(legalSheetName, " ", "")
legalSheetName = Left(legalSheetName, 31)

For Each cht In ActiveWorkbook.Charts
If cht.Name = legalSheetName Then Exit For
Next cht

If (Not cht Is Nothing) Then
cht.Delete
End If

Charts.Add.Name = legalSheetName
Set cht = Charts(legalSheetName)

If (cht Is Nothing) Then
MakeAGraph = "Failed to create chart: " & grphName & " with legal sheet name: " & legalSheetName
Exit Function
End If

While (cht.SeriesCollection.Count > 0)
cht.SeriesCollection(1).Delete
Wend

cht.HasTitle = True
cht.ChartTitle.Text = title
cht.ChartTitle.Font.Size = 16
cht.ChartType = xlXYScatterLines

' X axis
Dim XA As Excel.Axis
Set XA = cht.Axes(xlCategory)
XA.HasMajorGridlines = True
XA.HasMinorGridlines = True
XA.HasTitle = True
XA.AxisTitle.Characters.Text = xAxisTitle
XA.AxisTitle.Font.Size = 14
XA.AxisTitle.Font.Color = vbRed

' Y axis
Dim YA As Excel.Axis
Set YA = cht.Axes(xlValue, xlPrimary)
YA.HasMajorGridlines = True
YA.HasMinorGridlines = True
YA.HasTitle = True
YA.AxisTitle.Characters.Text = YA2AxisTitle 'titles switched
YA.AxisTitle.Font.Size = 14
YA.AxisTitle.Font.Color = vbBlue

' Second Y Axis
Dim YA2 As Excel.Axis
Set YA2 = cht.Axes(xlValue, xlSecondary)
YA2.HasMajorGridlines = True
YA2.HasMinorGridlines = True
YA2.HasTitle = True
YA2.AxisTitle.Characters.Text = yAxisTitle 'titles switched
YA2.AxisTitle.Font.Size = 14
YA2.AxisTitle.Font.Color = vbBlue





' Legend
cht.Legend.Font.Size = 12

Dim lastRow As Long
Dim serXRange As String
Dim serYRange As String
Dim serY2Range As String
Dim seriesColor As Long
Dim serName As String
Dim serFormula As String
Dim fromSheetName As String
Dim ser As Series
Dim cell As Long
Dim shtInfo As Worksheet

Set shtInfo = Worksheets("Info")

For cell = 1 To NumberOfCells()
If (isChecked(cell)) Then

fromSheetName = CStr(cell) & tabNameExtension
If SheetExistsWithName(fromSheetName) Then
If (Sheets(fromSheetName).Range(EXISTING_DATA_CHECK) <> "") Then
lastRow = GetLastRowNumberFromColumnNamed(Sheets(fromSheetName), colX)
serXRange = "'" & fromSheetName & "'!" & colX & START_DATA_ROW & ":" & colX & lastRow
serYRange = "'" & fromSheetName & "'!" & colY & START_DATA_ROW & ":" & colY & lastRow
serName = shtInfo.Cells(cell + 4, 4) & "-1"

serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serYRange & "," & cell & ")"
Set ser = cht.SeriesCollection.NewSeries

ser.Name = serName
ser.Formula = serFormula
seriesColor = shtCellList.Range("D2").Offset(cell, 0).Interior.Color


ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0

If YA2AxisTitle = "" Then

Else
serName = shtInfo.Cells(cell + 4, 4) & "-2"
serY2Range = "'" & fromSheetName & "'!" & ColY2 & START_DATA_ROW & ":" & ColY2 & lastRow
serFormula = "=SERIES(""" & serName & """," & serXRange & "," & serY2Range & "," & fromSheetName & ")"
Set ser = cht.SeriesCollection.NewSeries
ser.Name = serName

ser.Formula = serFormula
ser.AxisGroup = xlSecondary
ser.Border.Color = seriesColor
ser.MarkerBackgroundColor = seriesColor
ser.MarkerForegroundColor = seriesColor
ser.MarkerSize = 2
ser.Format.Line.Weight = 0
End If

End If
End If
End If
Next cell
End Function

- - - Updated - - -

Also the line that is giving me an error is Set YA2 = cht.Axes(xlValue, xlSecondary), this line will work however if i get rid of xlValue and just leave the secondary inside the ( )
 

Status
Not open for further replies.

Part and Inventory Search

Welcome to EDABoard.com

Sponsor

Back
Top