Is there a way to insert text to act as a "subtitle" under my chart's actual title using VBA? I would like to reference the input in cell "N21" as my subtitle text. Any help would be greatly appreciated.
Something along these lines should help you out, although I'm not sure on changing the font size.
ThisWorkbook.Sheets("Sheet1").ChartObjects(2).Activate
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "new title" & Chr(10) & Range("C3").Value
End With
The Chr(10) is your carriage return for a new line.
Following up on an excellent suggestion by Ditto, here is a VBA sub which adds a subtitle to an existing chart with an existing title, along with a test routine showing how it is called.
Sub AddSubtitle(Ch As Chart, subtitle As String, Optional fontsize As Long = 12)
Dim NewTitle As String
Dim i As Long, n As Long
Dim CT As ChartTitle
Set CT = Ch.ChartTitle
NewTitle = CT.Text
NewTitle = NewTitle & Chr(13)
i = 1 + Len(NewTitle)
NewTitle = NewTitle & subtitle
n = Len(subtitle)
CT.Text = NewTitle
CT.Format.TextFrame2.TextRange.Characters(i, n).Font.Size = fontsize
End Sub
Sub test()
Dim myChart As Chart
Set myChart = ActiveSheet.ChartObjects(1).Chart
AddSubtitle myChart, "Subtitle", 10
End Sub
Related
I need to convert a String to an Object, something like this.
Dim ObjectName As String
Dim Object As Object
ObjectName = "Label1"
Set Object = ObjectName
Object.Caption = "Text"
This is something that would really help me a lot, but I don't know if that is possible.
example from ms docs site. add label as shape
Sub test()
Set myDocument = Worksheets(1)
myDocument.Shapes.AddLabel(msoTextOrientationVertical, _
100, 100, 60, 150) _
.TextFrame.Characters.Text = "Test Label"
End Sub
Add the labels as ActiveX objects on a sheet and set their .Caption property as follows
Public Sub SetLabelText()
Dim i As Long, n As Long, Obj as Object
n = Sheet1.OLEObjects().Count
For i = 1 To n
Set Obj = Sheet1.OLEObjects(i).Object
Obj.Caption = "Text #" & CStr(i)
Next i
End Sub
with the expected result
You can also access a specific label, by name OLEObjects("Label1").Object
I have a macro that deletes all of the tables in my powerpoint and then a different macro to import the new tables from excel. I'm having trouble figuring out how to only delete that shape, however. The code I have right now deletes the title of the slide and all of the comments too (see below for current). Any ideas how to only remove that one shape? OR is it possible to delete only pictures and not text??
Dim sl As PowerPoint.Slide, sl_cnt As Long, pr As Object, pr_name As String, ppt As Object
Dim i As Long, j As Long
Set ppt = GetObject(, "PowerPoint.Application")
Set pr = ppt.Presentations(1)
For j = 10 To 1 Step -1
Set sl = pr.Slides(j)
For i = sl.Shapes.Count To 1 Step -1
sl.Shapes(i).Delete
Next i
Next j
'Record the date & time of procedure execution
Range("DeletePreviousPPTData").Value = Format(Now(), "mm/dd/yy") & " - " & Format(TimeValue(Now), "hh:mm AM/PM")
End Sub
Your code is deleting all of the shapes on the slide.
Before deleting each shape, make sure that it's a table.
As #BigBen mentioned, .HasTable will identify shapes that are tables, but it'll miss tables contained in content placeholders.
This IsTable function will test for both. Use it like so:
Sub YourSubName()
Dim sl As PowerPoint.Slide, sl_cnt As Long, pr As Object, pr_name As String, ppt As Object
Dim i As Long, j As Long
Set ppt = GetObject(, "PowerPoint.Application")
Set pr = ppt.Presentations(1)
For j = 10 To 1 Step -1
Set sl = pr.Slides(j)
For i = sl.Shapes.Count To 1 Step -1
' ADD THIS TEST
If IsTable(sl.Shapes(i)) then
sl.Shapes(i).Delete
End if
Next i
Next j
'Record the date & time of procedure execution
Range("DeletePreviousPPTData").Value = Format(Now(), "mm/dd/yy") & " - " & Format(TimeValue(Now), "hh:mm AM/PM")
End Sub
Function IsTable(oSh As Shape) As Boolean
If oSh.Type = msoPlaceholder Then
If oSh.PlaceholderFormat.ContainedType = msoTable Then
IsTable = True
End If
Else
If oSh.HasTable Then
IsTable = True
End If
End If
End Function
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.
I need to do a find-and-replace on pagesetup leftheader. Caveat is that I need to know the contents of the LeftHeader in order to replace it using Substitute. For example, the LeftHeader could contain:
Sheet 1 - Updated - 1/12/19
Printed on 6/3/19
I would do a find-and-replace on 1/12/19 and 6/3/19 using below example code:
Sub FnR_HF()
Dim sWhat As String, sReplacment As String
Const csTITLE As String = "Find and Replace"
sWhat = InputBox("Replace what", csTITLE)
If Len(sWhat) = 0 Then Exit Sub
sReplacment = InputBox("With what", csTITLE)
With ActiveSheet.PageSetup
' Substitute Header/Footer values
.LeftHeader = Application.WorksheetFunction.Substitute( _
.LeftHeader, sWhat, sReplacment)
End With
End Sub
The above doesn't allow me to retrieve the contents of the LeftHeader. Can anyone help?
Rather than find/replace, why not just rename it?
It will generate a popup box with your existing header showing, and you can type over it with whatever you want the new header to be. Seems easier?
Sub MakeAHeader()
Dim aText As String, WS As Worksheet
Set WS = ActiveSheet
aText = InputBox("What do you want the header to be?", "Make Yo Header", WS.PageSetup.LeftHeader)
WS.PageSetup.LeftHeader = aText
MsgBox "This is your header: " & WS.PageSetup.LeftHeader
End Sub
Try this code
Sub FnR_HF()
Dim sWhat As String, sReplacment As String, sHeader As String
Const csTITLE As String = "Find and Replace"
sHeader = ActiveSheet.PageSetup.LeftHeader
sWhat = InputBox("Replace what", sHeader)
If Len(sWhat) = 0 Then Exit Sub
sReplacment = InputBox("With What", csTITLE)
sHeader = Replace(sHeader, sWhat, sReplacment)
ActiveSheet.PageSetup.LeftHeader = sHeader
End Sub
I am learning to use VBA for excel in Excel 2016. At the moment I am working through an assignment on this website: http://www.homeandlearn.org/vba_charts_and_user_forms.html in which I want to show a scatter-plot of one of the football teams' results. This is done by selecting the team with a combobox in a user form.
The result of the code (see below) ought to be a scatterplot with One line and a title, like this:
http://www.homeandlearn.org/images/vba_charts/chart_arsenal.gif (cannot upload it for some reason)
However, this is the result of my code.
How is it possible that, with the exact same code as on the website, the Chart isn't able to show the selected data and title? I also wonder where the fifth series came from, since I only have four columns.
The code is as follows (and unique to the code described on the website):
Private Sub cmdLoad_Click()
If cbSelect.Text = "Select a chart" Then
MsgBox "Please select a chart"
Exit Sub
End If
Dim MyChart As Chart
Dim ChartData As Range
Dim ChartIndex As Integer
Dim ChartName As String
ChartIndex = cbSelect.ListIndex
Select Case ChartIndex
Case 0
Set ChartData = ActiveSheet.Range("B2:B20")
ChartName = ActiveSheet.Range("B1").Value
Case 1
Set ChartData = ActiveSheet.Range("C2:C20")
ChartName = ActiveSheet.Range("C1").Value
Case 2
Set ChartData = ActiveSheet.Range("D2:D20")
ChartName = ActiveSheet.Range("D1").Value
Case 3
Set ChartData = ActiveSheet.Range("E2:E20")
ChartName = ActiveSheet.Range("E1").Value
End Select
Application.ScreenUpdating = False
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
MyChart.SeriesCollection.NewSeries
MyChart.SeriesCollection(1).Name = ChartName
MyChart.SeriesCollection(1).Values = ChartData
MyChart.SeriesCollection(1).XValues = ActiveSheet.Range("A2:A20")
'Save chart as an image, remove the chart, then set updating screen to ON'
Dim imageName As String
imageName = ThisWorkbook.Path & "\gs16_pictures" & Application.PathSeparator & "TempChart.gif"
MyChart.Export Filename:=imageName, FilterName:="GIF"
ActiveSheet.ChartObjects(1).Delete
Application.ScreenUpdating = True
'Load picture in user form
UserForm1.Image1.Picture = LoadPicture(imageName)
cbSelect is initialized as follows
Private Sub UserForm_Initialize()
cbSelect.AddItem Range("B1") 'Arsenal
cbSelect.AddItem Range("C1") 'Man City
cbSelect.AddItem Range("D1") 'Newcastle
cbSelect.AddItem Range("E1") 'Cardiff
cbSelect.TextAlign = fmTextAlignCenter
End Sub
The problem was in the statement
Set MyChart = ActiveSheet.Shapes.AddChart(xlXYScatterLines).Chart
This statement automatically plotted the entire data table. To prevent it, it was necessary to explicitly state the SourceData. Below is the code which you need instead of the lines starting with MyChart.SeriesCollection
With MyChart
.SetSourceData Source:=ChartData
.HasTitle = True
.ChartTitle.Text = ChartName
.SeriesCollection(1).XValues = ActiveSheet.Range("A2:A20")
End With
I am not sure why there is a difference between Excel 2016 and the example from the website. Perhaps Excel is "smarter" than before and interpreted the source data.