I am trying to create a excel chart using vb6. Instead of feeding a excel range im trying to feed an array. And im getting an error.
This is the code that im working on
Private Sub CreateChart(Optional ByVal ChartTitle As String _
, Optional ByVal xAxis As Excel.Range _
, Optional ByVal yAxis As Excel.Range _
, Optional ByVal ColumnName As String _
, Optional ByVal LegendPosition As XlLegendPosition = xlLegendPositionRight _
, Optional ByVal rowIndex As Long = 2 _
, Optional ByRef ChartType As String = xlLineMarkers _
, Optional ByVal PlotAreaColorIndex As Long = 2 _
, Optional ByVal isSetLegend As Boolean = False _
, Optional ByVal isSetLegendStyle As Boolean = False _
, Optional ByVal LegendStyleValue As Long = 1)
Const constChartLeft = 64
Const constChartHeight = 300
Const constChartWidth = 700
Dim xlChart As Excel.ChartObject
Dim seriesCount As Long
Dim ColorIndex As Long
Dim j As Long
With mWorksheet
.Rows(rowIndex).RowHeight = constChartHeight
Set xlChart = .ChartObjects.Add(.Rows(rowIndex).Left, .Rows(2).Top, constChartWidth, constChartHeight)
End With
With xlChart.chart
.ChartType = ChartType
.SetSourceData Source:=marrayPOClient, PlotBy:=marrayPOSKU
.SeriesCollection(1).XValues = marrayPOClient
.HasTitle = True
.Legend.Position = LegendPosition
.Legend.Font.Size = 7.3
.Legend.Font.Bold = True
.Legend.Border.LineStyle = xlNone
.ChartTitle.Characters.Text = ChartTitle
.ChartTitle.Font.Bold = True
.Axes(xlValue).TickLabels.Font.Size = 8 ' yAxis Labels
.Axes(xlCategory).TickLabels.Font.Size = 8 ' xAxis Labels
.PlotArea.Interior.ColorIndex = PlotAreaColorIndex
.PlotArea.Interior.ColorIndex = 15
.PlotArea.Interior.PatternColorIndex = 1
.PlotArea.Interior.Pattern = xlSolid
End With
End Sub
Is it possible to use array for chart. If possible what are my mistakes.
As Mat's Mug says, SetSourceData requires a Range, but you can achieve the result using another method
Replace
.SetSourceData Source:=marrayPOClient, PlotBy:=marrayPOSKU
with
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = marrayPOClient
This will create a new series without a source, then assign the array as the series values
Chart.SetSourceData requires a Range object for its Source parameter, and an XlRowCol enum value for its PlotBy parameter.
I'm assuming both marrayPOClient and marrayPOSKU are arrays as their names imply (you haven't shown where they're declared and how they're assigned, so we can't know their type or value), but you need to supply a Range for the first parameter and, optionally, either xlColumns or xlRows for the second parameter.
Related
I'm trying to inspect an object when a new instance is created. The instance is created with a function DaySchedule.Create(). I can do that because I set the attribute VB_PredeclaredId = True. Here's the code of the function:
Public Function Create( _
ByVal Name As String, _
ByVal Cycle As Long, _
ByVal Prio As Long, _
ByVal startDate As Date, _
ByVal WeekDays As String) As WeekSchedule
Dim WeekDays_Arr() As String
Dim Days As Variant
me_Monday = False
me_Tuesday = False
me_Wednesday = False
me_Thursday = False
me_Friday = False
me_Saturday = False
me_Sunday = False
WeekDays_Arr = Split(WeekDays, ";")
For Each Days In WeekDays_Arr
Select Case Days
Case "Mo": me_Monday = True
Case "Tu": me_Tuesday = True
Case "We": me_Wednesday = True
Case "Th": me_Thursday = True
Case "Fr": me_Friday = True
Case "Sa": me_Saturday = True
Case "Su": me_Sunday = True
End Select
Next Days
me_ScheduleType = "weekly"
me_Name = Name
me_Cycle = Cycle
me_Prio = Prio
me_StartDate = startDate
Set Create = Me
End Function
The problem is whenever I open the locals window and try to expand Me Excel is loading infinitly. Sometimes it works after 20 seconds or so, but then every line take's 20 seconds. My CPU load is only 15% and I dont have other functions in the Excel workbook that might be calculated. Yesterday I have done exactly the same thing and it expanded instantly. Does anyone have a similar issue or the solution?
I found the solution. The problem lied in a property named Schedule_NextBackup. The Get-property didn't set a property but calculated something. I changed it to a function and it doesn't lag anymore.
I am receiving a run-time error '1004' on the line .Font.color = vbRed when setting conditional formats. The Sub works great on Excel 2011 for Mac, but fails on Windows.
I've tried rearranging the code, using RGB(255,0,0), setting .ColorIndex, as well as recording a macro and using that code. All failed in windows.
I'm trying to set the font color to red if the cell begins with "Med". The sub is called from here:
Public Const BASE As String = "$D$14"
Dim cols As Long
Dim rows As Long
Dim applyToRange As Range
Dim condition As String
' rows and cols variables set here...
Set applyToRange = Range(BASE, Range(BASE).Offset(rows - 1, cols - 1))
' Med
condition = "Med"
applyTextStringConditionals applyToRange, condition, xlBeginsWith, 0, False
What am I missing?
Private Sub applyTextStringConditionals(ByVal applyToRange As Range, ByVal matchString As String, _
ByVal operator As Long, ByVal color As Long, ByVal stopIfTrue As Boolean)
applyToRange.FormatConditions.Add Type:=xlTextString, String:=matchString, TextOperator:=operator
applyToRange.FormatConditions(applyToRange.FormatConditions.Count).SetFirstPriority
If color = 0 Then
With applyToRange.FormatConditions(1)
.Font.color = vbRed '<--- Error 1004 here
'.TintAndShade = 0
End With
Else
applyToRange.FormatConditions(1).Interior.color = color
End If
applyToRange.FormatConditions(1).stopIfTrue = stopIfTrue
End Sub
UPDATE:
This works, only if it's the first conditional format created:
Set applyToRange = Range(BASE, Range(BASE).Offset(rows - 12, cols - 1))
' Med
condition = "Med"
Stop
applyToRange.FormatConditions.Add Type:=xlTextString, String:=condition, TextOperator:=xlBeginsWith
applyToRange.FormatConditions(applyToRange.FormatConditions.Count).SetFirstPriority
applyToRange.FormatConditions(1).Font.Color = vbRed '-16776961
applyToRange.FormatConditions(1).stopIfTrue = True
But this does not:
Private Sub applyTextStringConditionals(ByVal l_applyToRange As Range, ByVal matchString As String, _
ByVal l_Operator As Long, ByVal setColor As Long, ByVal l_stopIfTrue As Boolean)
l_applyToRange.FormatConditions.Add Type:=xlTextString, String:=matchString, TextOperator:=l_Operator
l_applyToRange.FormatConditions(l_applyToRange.FormatConditions.Count).SetFirstPriority
If setColor = 0 Then
l_applyToRange.FormatConditions.Item(1).Font.Color = vbRed
Else
l_applyToRange.FormatConditions(1).Interior.Color = setColor
End If
l_applyToRange.FormatConditions(1).stopIfTrue = True
end sub
I am trying to write a simple code that filters out data based on some condition.
My code is below :
Public Function fGetUniqInitiative(Optional ByVal uniqInitiative As Variant, Optional ByVal filter1 As Variant, Optional ByVal filter2 As Variant, Optional ByVal filter3 As Variant, Optional ByVal vartempData As Variant) As Variant()
Dim lngcounterinitiatve As Long
Dim lngVarData As Long
Dim lngfilter1 As Long
Dim lngfilter2 As Long
Dim lngfilter3 As Long
Dim boolfilter1 As Boolean
Dim boolfilter2 As Boolean
Dim boolfilter3 As Boolean
Dim varUniqueList() As Variant
Dim lnguniqueinitcount As Long
lnguniqueinitcount = 0
For lngcounterinitiative = LBound(uniqInitiative) To UBound(uniqInitiative)
boolfilter1 = False
boolfilter2 = False
boolfilter3 = False
For lngVarData = LBound(vartempData) To UBound(vartempData)
If uniqInitiative(lngcounterinitiative) = vartempData(lngVarData, 2) Then
For lngfilter1 = LBound(filter1) To UBound(filter1)
If vartempData(lngVarData, 9) = filter1(lngfilter1) Then
boolfilter1 = True
Exit For
End If
Next lngfilter1
For lngfilter2 = LBound(filter2) To UBound(filter2)
If vartempData(lngVarData, 10) = filter2(lngfilter2) Then
boolfilter2 = True
Exit For
End If
Next lngfilter2
For lngfilter3 = LBound(filter3) To UBound(filter3)
If vartempData(lngVarData, 11) = filter3(lngfilter3) Then
boolfilter3 = True
Exit For
End If
Next lngfilter3
If boolfilter1 = True Or boolfilter2 = True Or boolfilter3 = True Then
Exit For
Else
lnguniqueinitcount = lnguniqueinitcount + 1
ReDim varUniqueList(1 To lnguniqueinitcount)
End If
End If
Next lngVarData
Next lngcounterinitiatve
fGetUniqInitiative = varUniqueList
End Function
However, when i try to compile the code it gives the error "Invalid Next Control Variable reference". I have googled it quite a bit and all the solutions say that i must be missing closing the loop which i don't think is the case in my code. Anyone could point what am i missing?
lngcounterinitiative is spelled wrong in "Next lngcounterinitiatve".Try changing that.
I am looking to create custom pop up displays on a chart using vba.
Like this except instad of "Value: 6" display the corresponding comment. "Yes"
Here is an article with an example workbook that shows a textbox when hovering over a point on the chart. The explanations on the website are not detailed enough for me to understand what is going on. When I try and modify the example workbook it stops functioning.
Is there a method to tracing excel vba code to discover what it is doing? Or, is there a better simple method for creating custom tooltips with excel charts?
Thanks.
Creating a chart (as a new sheet, not an embedded chart) and editing the VBA code for the sheet to:
Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim ElementID As Long
Dim Arg1 As Long
Dim Arg2 As Long
Dim chart_data As Variant
Dim chart_label As Variant
Dim last_bar As Long
Dim chrt As Chart
Dim ser As Series
On Error Resume Next
Me.GetChartElement x, y, ElementID, Arg1, Arg2
Application.ScreenUpdating = False
Set chrt = ActiveChart
Set ser = ActiveChart.SeriesCollection(1)
Set ser2 = ActiveChart.SeriesCollection(2)
chart_data1 = ser.Values
chart_label1 = ser.XValues
chart_data2 = ser2.Values
chart_label2 = ser2.XValues
Set txtbox = ActiveSheet.Shapes("hover")
If ElementID = xlSeries Then
If Err.Number Then
Set txtbox = ActiveSheet.Shapes.AddTextbox _
(msoTextOrientationHorizontal, x, y, 400, 120) 'Textbox size
txtbox.Name = "hover"
txtbox.Fill.Solid
txtbox.Fill.ForeColor.SchemeColor = 9
txtbox.Line.DashStyle = msoLineSolid
chrt.Shapes("hover").TextFrame.Characters.Text = "Insert text wanted to display here"
With chrt.Shapes("hover").TextFrame.Characters.Font
.Name = "Arial"
.Size = 14
.ColorIndex = 16
End With
last_bar = Arg2
End If
ser.Points(Arg2).Interior.ColorIndex = 44
txtbox.Left = 0 'textbox location
txtbox.Top = 0 'textbox location
Else
txtbox.Delete
ser.Interior.ColorIndex = 16
End If
Application.ScreenUpdating = True
End Sub
This created a textbox when the mouse movement was over an Element of "xlSeries".
Context:
I have several groups that I've made in Excel 2007 that each consist of a textbox and image(s) and are each assigned to a macro.
What I would like is upon a mouseover/hover of the group, it displays a 'tooltip' that contains more detailed info about what the assigned macro does. I've come across what looks to be a solution here: http://www.vbaexpress.com/forum/showthread.php?t=15084 However, I don't know how to figure out the assigned name to an image so I can use the name in the code, and I'm not sure how to incorporate it to use a Group object instead, or if it's even possible to do with groups.
Question:
As per title, how do I display a tooltip/infotip for a group (textbox + images) assigned to a macro?
EDIT: I've enclosed a copy of the code found in the link so people don't have to go page hopping:
Code that goes in a general, public module:
Option Explicit
Declare Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long
Declare Function GetSysColor Lib "user32" ( _
ByVal nIndex As Long) As Long
Public Function CreateToolTipLabel(objHostOLE As Object, _
sTTLText As String) As Boolean
Dim objToolTipLbl As OLEObject
Dim objOLE As OLEObject
Const SM_CXSCREEN = 0
Const COLOR_INFOTEXT = 23
Const COLOR_INFOBK = 24
Const COLOR_WINDOWFRAME = 6
Application.ScreenUpdating = False 'just while label is created and formatted
For Each objOLE In ActiveSheet.OLEObjects
If objOLE.Name = "TTL" Then objOLE.Delete 'only one can exist at a time
Next objOLE
'create a label control...
Set objToolTipLbl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1")
'...and format it to look as a ToolTipWindow
With objToolTipLbl
.Top = objHostOLE.Top + objHostOLE.Height - 10
.Left = objHostOLE.Left + objHostOLE.Width - 10
.Object.Caption = sTTLText
.Object.Font.Size = 8
.Object.BackColor = GetSysColor(COLOR_INFOBK)
.Object.BackStyle = 1
.Object.BorderColor = GetSysColor(COLOR_WINDOWFRAME)
.Object.BorderStyle = 1
.Object.ForeColor = GetSysColor(COLOR_INFOTEXT)
.Object.TextAlign = 1
.Object.AutoSize = False
.Width = GetSystemMetrics(SM_CXSCREEN)
.Object.AutoSize = True
.Width = .Width + 2
.Height = .Height + 2
.Name = "TTL"
End With
DoEvents
Application.ScreenUpdating = True
'delete the tooltip window after 5 secs
Application.OnTime Now() + TimeValue("00:00:05"), "DeleteToolTipLabels"
End Function
Public Sub DeleteToolTipLabels()
Dim objToolTipLbl As OLEObject
For Each objToolTipLbl In ActiveSheet.OLEObjects
If objToolTipLbl.Name = "TTL" Then objToolTipLbl.Delete
Next objToolTipLbl
End Sub
Code that goes in the sheet (right click sheet tab>code)
Private Sub Image1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim objTTL As OLEObject
Dim fTTL As Boolean
For Each objTTL In ActiveSheet.OLEObjects
fTTL = objTTL.Name = "TTL"
Next objTTL
If Not fTTL Then
CreateToolTipLabel Image1, "ToolTip Label"
End If
End Sub