Excel Chart Hyperlink - excel

I use the following code to add a hyperlink to a chart, linking it to a different worksheet:
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:= _
"'Sheet2'!A1"
However this creates a link that is activated when clicking on the entire chart. The pie chart has 4 segments (each relating to a different series) and I would like each segment to link to a different worksheet. So the first segment will go to Sheet2, the second segment to Sheet3 and so on.
Is there a way to add an anchor to each individual segment rather than to the entire chart as a whole?

It took me 12 hours because I had the same question. Here is how I got it to work starting from a brand new excel workbook:
1) Make up the data for a pie chart
Name Score
Art 20
Bob 15
Joe 19
Tim 5
2) Insert a pie chart so that it appears as an object in the same worksheet
3) Right click "view code" on the Sheet1 tab.
4) Insert a "Class Module" -- probably called "Class1" by default
5) Paste the following code into the Class Module:
Option Explicit
Public WithEvents ChartObject As Chart
Private Sub ChartObject_MouseUp(ByVal Button As Long, ByVal Shift As Long, _
ByVal x As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement x, y, ElementID, Arg1, Arg2
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.Index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.Index _
(.SeriesCollection(Arg1).Values, Arg2)
' Display message box with point information
MsgBox "Series " & Arg1 & vbCrLf _
& """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
& "Point " & Arg2 & vbCrLf _
& "X = " & myX & vbCrLf _
& "Y = " & myY
Range("A1").Select
' Don't crash if chart doesn't exist
On Error Resume Next
' Activate the appropriate chart
' ThisWorkbook.Charts("Chart " & myX).Select
Sheets("Series " & myX & " Detail").Select
Range("A1").Select
On Error GoTo 0
End If
End If
End With
End Sub
6) The above code works only if we can trick excel to treating "chartobjects" as "charts". To do that:
Open the code "This Workbook" using view code.
7) Paste the following:
Dim ChartObjectClass As New Class1
Private Sub Workbook_Open()
Set ChartObjectClass.ChartObject = Worksheets(1).ChartObjects(1).Chart
End Sub
8) The coding in the class module is rigged to go to tabs named "Series Art Detail", "Series Joe Detail", "Series Bob Detail", and Series "Tim Detail"
Create those 4 tabs.
The mapping of the pie slices to the tabs is near the bottom line in the Class code.
9) Test and enjoy!

Use the following code:
Option Explicit
Public WithEvents CHT As Chart
Private Sub Workbook_Open()
Set CHT = ActiveSheet.ChartObjects(1).Chart
End Sub
Private Sub CHT_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
On Error GoTo Fin
If Selection.Name = "Series1" Then
Application.Goto ActiveWorkbook.Sheets("Sheet2").Range("A1")
End If
Fin:
End Sub

Related

Excell VBA Shell command not working but it does work from the windows command window

The code below Works with Excel 2016
When the user clicks a cell in column A (after the first few header rows are checked)
The value of the contents of the cell is stored in the string variable stockcode.
The Sub Spark() is where the problem lies, in particular Call Shell(stAppName, 0)
stAppName = "C:\Autoit\Spark_test_10_Excel.a3x " & stockcode
Debug.Print stAppName
Call Shell(stAppName, 0)
The application being called displays a chart.
In the debug window you can see the call string C:\Autoit\Spark_test_10_Excel.a3x BHP
If I copy and paste that output into the windows 10 search window the string opens the app and displays a chart perfectly. I also compiled the Autoit script to an EXE That performed exactly as described above. No difference.
Also not the Notepad test commented out. That also worked perfectly.
I guess this is problem is security related. I have tried numerous workarounds none worked so far.
Any suggestions will be gratefully received
Option Explicit
Public stAppName As String
Public stockcode As String
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Const PM_NOREMOVE = &H0
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Message As MSG
'check for left-mouse button clicks.
PeekMessage Message, 0, 0, 0, PM_NOREMOVE
If Message.Message = 512 Then
Debug.Print "You clicked cell: " & Selection.Address, Selection.Value
End If
On Error GoTo FoundAnError 'the user probably clicked somewhare not in column A in the sheet
stockcode = Selection.Value
Call Spark
FoundAnError:
MsgBox ("there was a VBA code error it should have been addressed")
End Sub
Sub Spark()
Debug.Print "Spark: " & Selection.Address, Selection.Value
If ActiveCell.Column = 1 Then
If stockcode = "Ticker Symbol" Then
Debug.Print "Ticker", stockcode
Exit Sub
End If
If Selection.Value = "" Then
Debug.Print "No stock code ", stockcode
Exit Sub
End If
Debug.Print "stock code in call ", stockcode
'Shell "Notepad", vbNormalFocus 'Yes this works as a test
'On Error GoTo 0
stAppName = "C:\Autoit\Spark_test_10_Excel.a3x " & stockcode
Debug.Print stAppName
'EDIT
'Call Shell(stAppName, 0)This does not work!
Shell "cmd.exe /C " & stAppName, vbHide 'Works
'This Works Thanks FaneDuru
End If
End Sub
This is the output from the debug window running the above code
You clicked cell: $A$7 BHP
Spark: $A$7 BHP
stock code in call BHP
C:\Autoit\Spark_test_10_Excel.a3x BHP

Looking to add High and Low toolstips to xlStockOHLC candlestick charts in VBA

Running on Windows.
I see plenty of examples on SO but they're all in JS.
I am using VBA and creating my candlestick chart with the following:
OHLCChartObject.name = OHLCChartName
With OHLCChartObject.Chart
.SetSourceData Source:=getOHLCChartSource
.ChartType = xlStockOHLC
.Axes(xlCategory).CategoryType = xlCategoryScale
.HasTitle = True
.ChartTitle.Text = ""
.HasLegend = False
With .ChartGroups(1)
.UpBars.Interior.ColorIndex = 10
.DownBars.Interior.ColorIndex = 3
End With
End With
End Sub
Is there any way to add tooltips to show the actual Open/High/Low/Close values?
May try Some workaround this.
Instead of changing Toolstip, in test it is used to show values in a Shape "Rectangle 2" embedded in the chart itself. However it could be easily modified to show the results along with the title or Datalabel of the point with mouse move.
Create a class module named XChart with Chart Events
Class module Code
Edited: added additional functionality of modifying data labels.
Option Explicit
Public WithEvents Ohlc As Chart
Public Arr1 As Variant, Arr2 As Variant, Arr3 As Variant, Arr4 As Variant
Private Sub Ohlc_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim IDNum As Long, a As Long, b As Long
Dim i As Long, txt As String, ht As Long, txt2 As String
Ohlc.GetChartElement x, y, IDNum, a, b
If IDNum <> xlSeries Then
'Finding XlSeries in OHLC chart is little difficult
'So try all Y values correspoding to X in the chart to find XlSeries
'However this compromise performace
ht = Ohlc.Parent.Height
For y = 1 To ht
Ohlc.GetChartElement x, y, IDNum, a, b 'c, d
If IDNum = xlSeries Then Exit For
Next
End If
If IDNum = xlSeries Then
' For Test purpose, May delete next 5 lines
ActiveSheet.Range("L1").Value = x
ActiveSheet.Range("L2").Value = y
ActiveSheet.Range("L3").Value = IDNum
ActiveSheet.Range("L4").Value = a
ActiveSheet.Range("L5").Value = b
If b > 0 Then
ActiveSheet.Range("M1").Value = Arr1(b) ' For Test purpose, may delete
txt = "Open: " & Arr1(b) & " High: " & Arr2(b) & vbCrLf & _
"Low: " & Arr3(b) & " Close: " & Arr4(b)
txt2 = "O: " & Arr1(b) & " H: " & Arr2(b) & _
" L: " & Arr3(b) & " C: " & Arr4(b)
Ohlc.Shapes("Rectangle 2").TextEffect.Text = txt
For i = 1 To Ohlc.SeriesCollection(1).Points.Count
With Ohlc.SeriesCollection(1).Points(i)
If i = b Then
.HasDataLabel = True
.DataLabel.Text = txt2
Else
.HasDataLabel = False
End If
End With
Next
End If
End If
End Sub
Public Sub Storevalues()
Arr1 = Ohlc.SeriesCollection(1).Values
Arr2 = Ohlc.SeriesCollection(2).Values
Arr3 = Ohlc.SeriesCollection(3).Values
Arr4 = Ohlc.SeriesCollection(4).Values
End Sub
Next in the VBA Code in standard module where Chart was created or in some other event / procedure, set the Chart as new XChart. For test an already existing chart is used. it may also be used at workbook open event.
Public XOhlc As New XChart
Sub initChart()
Dim Ch As Chart
'Modify the line to your requirement
Set Ch = ThisWorkbook.Worksheets("Sheet1").ChartObjects("Chart 3").Chart
Set XOhlc.Ohlc = Ch
XOhlc.Storevalues
End Sub
All the Sheet,Chart, Shape etc names may please be modified to requirement.
Do you want Tooltips, or Data Labels?
A candlestick chart has Tooltips that appear when your mouse moves over any of the data points (high or low at the ends of the whiskers, open or close at the ends of the boxes).
Data Labels are permanent labels adjacent to a chart's data points. These are added by clicking the plus icon floating beside the chart and checking the box next to Data Labels, or finding the relevant command on the ribbon. I fear that data labels on every point will make the chart cluttered.

VBA Combobox / automatically generate code

I've got a question concerning combobox in Excel.
I've got an excel sheet that by default contains two comboboxes and their number is described by a variable x (x=2 by default). Each combobox is scripted to behave in a particular way in subs, for example I've got: private sub ComboBox1_DropButtonClick().
Nonetheless, sometimes I need to increase the number of these boxes by changing the value of X. I may need up to 10 comboboxes in total. Now the question is whether there's any way in which I can set the behaviour of an infinite number of comboboxes (for example in the event of DropButtonClick). What I did was to write a code for each of those comboboxes, so I've got a sub for ComboBox1_DropButtonClick(), ComboBox2_DropButtonClick(), ComboBox3_DropButtonClick(), etc.. The code varies a bit, but it's repeatable. So it all looks rather dumb and I'm searching for some more ingenious solution. Maybe all those comboboxes can be scripted in one go? If there's any way to do it, please share it with me.
Thanks, Wojciech.
[edit] Location of my code (marked in grey):
Screenshot from VBA editor in VBA
Here is some code to dynamically add controls to an Excel Userform, and add the code behind. The code added will make it display a MessageBox when the ComboBox receives a KeyDown.
The code is somewhat commented, but let me know if you have questions :)
Option Explicit
Sub CreateFormComboBoxes(NumberOfComboBoxes As Long)
Dim frm As Object
Dim ComboBox As Object
Dim Code As String
Dim i As Long
'Make a blank form called 'UserForm1', or any name you want
'make sure it has no controls or any code in it
Set frm = ThisWorkbook.VBProject.VBComponents("UserForm1")
With frm
For i = 1 To NumberOfComboBoxes
Set ComboBox = .designer.Controls.Add("Forms.ComboBox.1")
'Set the properties of the new controls
With ComboBox
.Width = 100
.Height = 20
.Top = 20 + ((i - 1) * 40) 'Move the control down
.Left = 20
.Visible = True
.ZOrder (1)
.Name = "ComboBox" & i
End With
'Add your code for each module, you can add different code, by adding a if statement here
'And write the code depending on the name, index, or something else
Code = Code & vbNewLine & "Private Sub " & "ComboBox" & i & "_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & _
vbNewLine & " MsgBox(""hi"")" & vbNewLine & "End Sub"
Next
'Add the code
.CodeModule.InsertLines 2, Code
End With
End Sub
'Run this
Sub Example()
CreateFormComboBoxes 5
End Sub
**Edit**
I figured I might as well add the other approach for adding controls dynamically to an Excel sheet. I'd recommend sticking to UserForms, but, here's a method that should help out when controls are needed in a Sheet.
Sub addCombosToExcelSheet(MySheet As Worksheet, NumberOfComboBoxes As Long, StringRangeForDropDown As String)
Dim i As Long
Dim combo As Shape
Dim yPosition As Long
Dim Module As Object
yPosition = 20
For i = 1 To NumberOfComboBoxes
yPosition = (i - 1) * 50
'Create the shape
Set combo = MySheet.Shapes.AddFormControl(xlDropDown, 20, yPosition, 100, 20)
' Range where the values are stored for the dropDown
combo.ControlFormat.ListFillRange = StringRangeForDropDown
combo.Name = "Combo" & i
Code = "Sub Combo" & i & "_Change()" & vbNewLine & _
" MsgBox(""hi"")" & vbNewLine & _
"End Sub"
'Add the code
With ThisWorkbook
'Make sure Module2 Exits and there is no other code present in it
Set Module = .VBProject.VBComponents("Module2").CodeModule
Module.AddFromString (Code)
End With
'Associate the control with the action, don't include the () at the end!
combo.OnAction = "'" & ActiveWorkbook.Name & "'!Combo" & i & "_Change"
Next
End Sub
Sub Example()
Dim sht As Worksheet: Set sht = ThisWorkbook.Sheets(1)
addCombosToExcelSheet sht, 10, "Sheet1!$A$1:$A$10"
End Sub

Need to run code of Chart sheet from any other chart sheet module or normal module or any class

A part of main code is related to chart sheet which enables a click on a chart(Coding is done in chart sheet ) triggers a macro. But the main program involves deleting and creation of chart sheet. Once the program deletes the Chart sheet, the code in chart sheet also gets deleted. How to execute the chart sheet code when i create a new chart?
Sub AddNewChart()
Dim Newchart As Chart, ram As String, ram1 As String, num As Long
num = InputBox("Please Enter the Sheet Number", "Sheet Number")
'To execute code in particular sheet number
ram = Worksheets(num).Range("AY4").End(xlDown).Address(False, False)
ram1 = Worksheets(num).Range("AZ4").End(xlDown).Address(False, False)
Set Newchart = Charts.Add
With Newchart
.ChartType = xlXYScatterLinesNoMarkers
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = "=""Values"""
.SeriesCollection(1).XValues = Worksheets(num).Range("AY4", ram)
.SeriesCollection(1).Values = Worksheets(num).Range("AZ4", ram1)
End With
Application.DisplayAlerts = False
Sheets("Ravi").Delete
'*sheet named ravi is deleted along with code*
Application.DisplayAlerts = True
Newchart.Name = "Ravi"
'How to get another code in this Ravi Chart sheet module?
Sheets("Ravi").Activate
End Sub
Below one is Chartsheet code which is to be present inside chart sheet module even after deletion and replacing.
Sub Chart_mouseup(ByVal Button As Long, ByVal Shift As Long, _ByVal x As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement x, y, ElementID, Arg1, Arg2
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.Index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.Index _
(.SeriesCollection(Arg1).Values, Arg2)
' Display message box with point information
MsgBox "Series " & Arg1 & vbCrLf _
& """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
& "Point " & Arg2 & vbCrLf _
& "X = " & myX & vbCrLf _
& "Y = " & myY
End If
End If
End With
End Sub
You need to create a separate class module outside of the chart's code module to handle events in any chart, then use other code to link this class to the chart whose events you need to capture.
Essentially you add a class module, and name it C_ChartEvents. Include the event code that you've placed in your chart's code module, and in the declarations section (just under Option Explicit) insert
Public With Events Cht As Chart
Then modify the existing code to use Cht_ instead of Chart_ as the prefix for each event procedure's name, e.g.,
Sub Cht_MouseUp(ByVal Blah As Blah...)
At the top of the code module where you create a new chart, insert:
Dim clsChartEvents As New C_ChartEvents
After you create the chart (say, after the With NewChart/End With block) insert:
Set clsChartEvents.Cht = NewChart
Now NewChart will respond to the events with the procedures in C_ChartEvents.
I have written a tutorial, Chart Events in Microsoft Excel, that has more of the gory details.

Detect the type of Selection in a Worksheet just deactivated

I want a method to inquire, after changing the ActiveSheet, without additional Activating/Deactivating:
The type of Selection in the previous active sheet (of most importance, if it was a ChartObject or Range).
If it is a Range, get the address.
Is this possible ...?
PS: answers to this one will help me getting to the answer of Detect the type of Selection in a Worksheet just deactivated, in any open Workbook. But they are not the same.
You need two separate events to capture the selection, plus a global variable to store the prior object type and name/location.
Worksheet_SelectionChange for a range
A Chart_Select event for the chartobject
For (2) in Excel 2013 there is such an event but for earlier versions we will need a class module
This is accomplished using Jon Peltier's code as a base
There are three code sections below, add them to your workbook with the names and locations as indicated. Then run Set_All_Charts to initialise the charts in the first sheet for the chart class module
Class Module called clsEventChart
Option Explicit
Public WithEvents evtchart As Chart
Private Sub EvtChart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
MsgBox "Changed from : " & TypeName(X) & " " & StrPos & " to" & vbNewLine & "Chart: " & evtchart.Name
StrPos = evtchart.Name
Set X = evtchart
End Sub
normal module
Option Explicit
Public StrPos As String
Public X As Object
Dim clsEventCharts() As New clsEventChart
Sub Set_All_Charts()
Dim ws As Worksheet
Set ws = Sheets(1)
With ws
If .ChartObjects.Count > 0 Then
ReDim clsEventCharts(1 To ws.ChartObjects.Count)
Dim chtObj As ChartObject
Dim chtnum As Integer
chtnum = 1
For Each chtObj In ws.ChartObjects
' Debug.Print chtObj.Name, chtObj.Parent.Name
Set clsEventCharts(chtnum).evtchart = chtObj.Chart
chtnum = chtnum + 1
Next ' chtObj
End If
End With
End Sub
Sheet Event
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "Changed from " & TypeName(X) & ": " & StrPos & " to: " & vbNewLine & "Range: " & Target.Address
Set X = Selection
StrPos = Target.Address
End Sub
This answer is for part 2 of your question.
Declare oldTarget outside of the SelectionChange event so you can utilize it from other events, such as a change event.
To place in your worksheet code:
Dim oldTarget As Variant
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox ("Address changed from : " & oldTarget & vbNewLine & _
" to: " & Target.Address)
oldTarget = Target.Address
End Sub
Note:
The first selection you make will not have an oldTarget. After that, it will print a Message displaying the old address and new address.

Resources