How to make chart embedded in active sheet?

R

RB Smissaert

When I record making a chart embedded in the sheet I get this:

Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("testsheet"). _
Range("J3:K14"), PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:= _
"testsheet"

But this doesn't work as it falls over at the line where the location is
set:

Set objChart = Charts.Add

With objChart
.Location xlLocationAsObject, strName
.ChartType = xlColumnClustered
.SetSourceData _
Source:=rngRange, _
PlotBy:=xlColumns
End With

The error will be:
runtime error 1004, method location of object chart failed.
A chart has already been made, but not this is a chart in a new chartsheet
and I don't want that.
How should this be done?


RBS
 
R

RB Smissaert

OK, this works:

Set objChart = Charts.Add

With objChart
.Location xlLocationAsObject, strSheetName
End With

With ActiveChart
.SetSourceData _
Source:=rngRange, _
PlotBy:=xlColumns
.ChartType = xlColumnClustered
.HasTitle = True
.ChartTitle.Characters.Text = strName
.HasLegend = False
End With

Understand now that the second argument of .Location has to be an existing
sheet.

Now the strange thing is that this works fine in my first range, but if I
run the same
on a different range I get no proper columns anymore, but very thin lines,
although it is
still the column type of chart. This other range has the same kind of data
as the first range.

RBS
 
P

Peter T

Hi Bart,

I was just about to post some example stuff when and your follow-up appeared
answering your own question. But you might as well have it any way -

Sub test()
Dim ws As Worksheet
Dim ch As Chart
Dim chObj As ChartObject
Dim r As Range
Set ws = ActiveSheet

Set r = ws.Range("b2")

Set ch = ws.ChartObjects.Add(r.Left, r.Top, 200, 120).Chart

With ch
.ChartType = xlColumnClustered
.SetSourceData ws.Range("A1:b5"), xlColumns
.Parent.Name = ("MyCart1")
.HasTitle = True
.ChartTitle.Text = .Parent.Name
End With

With ws.ChartObjects.Add(300, 50, 200, 120)
.Name = "MyChart2"
With .Chart
.ChartArea.AutoScaleFont = False
'.ChartArea.Font.Size = 10
.ChartType = xlColumnClustered
.SetSourceData ws.Range("A1:b5"), xlColumns
.HasTitle = True
.ChartTitle.Text = .Parent.Name
.Parent.Activate
.ChartArea.Select
End With
End With

On Error Resume Next
Set ch = ActiveChart
If Not ch Is Nothing Then
MsgBox ch.Parent.Name
End If

With ws.ChartObjects("MyCart1")
.Activate
.Chart.ChartArea.Select
End With

Set ch = ActiveChart
If Not ch Is Nothing Then
MsgBox ch.Parent.Name
End If
End Sub

I don't think you need .Location when adding a chart if adapting the above,
or need to select anything.

Re your comments about unexpected sizing, note .ChartArea.AutoScaleFont =
False in the above, which you can reset later.

Regards,
Peter T
 
R

RB Smissaert

Hi Peter,

Thanks, will have a look.

RBS

Peter T said:
Hi Bart,

I was just about to post some example stuff when and your follow-up
appeared
answering your own question. But you might as well have it any way -

Sub test()
Dim ws As Worksheet
Dim ch As Chart
Dim chObj As ChartObject
Dim r As Range
Set ws = ActiveSheet

Set r = ws.Range("b2")

Set ch = ws.ChartObjects.Add(r.Left, r.Top, 200, 120).Chart

With ch
.ChartType = xlColumnClustered
.SetSourceData ws.Range("A1:b5"), xlColumns
.Parent.Name = ("MyCart1")
.HasTitle = True
.ChartTitle.Text = .Parent.Name
End With

With ws.ChartObjects.Add(300, 50, 200, 120)
.Name = "MyChart2"
With .Chart
.ChartArea.AutoScaleFont = False
'.ChartArea.Font.Size = 10
.ChartType = xlColumnClustered
.SetSourceData ws.Range("A1:b5"), xlColumns
.HasTitle = True
.ChartTitle.Text = .Parent.Name
.Parent.Activate
.ChartArea.Select
End With
End With

On Error Resume Next
Set ch = ActiveChart
If Not ch Is Nothing Then
MsgBox ch.Parent.Name
End If

With ws.ChartObjects("MyCart1")
.Activate
.Chart.ChartArea.Select
End With

Set ch = ActiveChart
If Not ch Is Nothing Then
MsgBox ch.Parent.Name
End If
End Sub

I don't think you need .Location when adding a chart if adapting the
above,
or need to select anything.

Re your comments about unexpected sizing, note .ChartArea.AutoScaleFont =
False in the above, which you can reset later.

Regards,
Peter T
Click to expand...
 
T

Tushar Mehta

Thin lines in a bar chart is a sign that there are many data points (or
data points far apart for a time-scale x-axis. Check what range XL
plotted, the x-values, and what kind of x-axis XL created.

To deal with the location issue, you are on the right track. When you
move the move the chart from its own sheet to a worksheet, the object
the variable objChart pointed to no longer exists and you get errors on
subsequent statements. However, that does not mean you have to rely on
'ActiveChart' for further work. Instead use objChart with

Set objChart = Charts.Add.Location( _
xlLocationAsObject, strSheetName)
with objChart
...


--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
R

RB Smissaert

Thanks, I got this working now.
As I wanted the range that provides the chart data in the top right corner
of the screen I made a Sub that does that.
Maybe somebody has a better or shorter code to do the same:


Sub TopRightAlignRange(rngTopRight As Range)

Dim bError As Boolean
Dim lRangeRightCol As Long
Dim lVisibleRangeRightCol As Long
Dim bAdjustWidth As Boolean

Application.ScreenUpdating = False

'top align top row of range
'--------------------------
ActiveWindow.ScrollRow = rngTopRight.Cells(1).Row


lRangeRightCol = rngTopRight.Cells(rngTopRight.Cells(1).Row, _
rngTopRight.Columns.count).Column

lVisibleRangeRightCol = _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column


If lRangeRightCol =
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row, _
ActiveWindow.VisibleRange.Columns.count).Column
Then
Exit Sub
End If

If lRangeRightCol < lVisibleRangeRightCol Then
'first try left scroll to align right side of range to right screen
edge
'-----------------------------------------------------------------------
Do Until lRangeRightCol = _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Or _
lRangeRightCol > _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Or _
ActiveWindow.ScrollColumn
= 1
ActiveWindow.SmallScroll ToLeft:=1
If Err.Number <> 0 Then
bError = True
Exit Do
End If
If lRangeRightCol > _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Then
ActiveWindow.SmallScroll ToRight:=1
bAdjustWidth = True
Exit Do
End If
Loop
Else
'first try right scroll to align right side of range to right screen
edge
'-----------------------------------------------------------------------
Do Until lRangeRightCol = _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Or _
lRangeRightCol < _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column

ActiveWindow.SmallScroll ToRight:=1
If Err.Number <> 0 Then
bError = True
On Error GoTo 0
Exit Do
End If
If lRangeRightCol < _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Then
bAdjustWidth = True
Exit Do
End If
Loop
End If

If bError Or _
lRangeRightCol <> _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Then
If lRangeRightCol <
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row, _
ActiveWindow.VisibleRange.Columns.count).Column
Then
Do Until lRangeRightCol = _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Columns(1).ColumnWidth = Columns(1).ColumnWidth + 1
Loop
Else
Do Until lRangeRightCol = _
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells(1).Row,
_
ActiveWindow.VisibleRange.Columns.count).Column
Columns(1).ColumnWidth = Columns(1).ColumnWidth + -1
Loop
End If
End If

Application.ScreenUpdating = True

End Sub


Sub MakeChartFromRange()

Dim strName As String
Dim oChart As Chart
Dim oChartObject As ChartObject
Dim oSheet As Worksheet
Dim lFirstRow As Long
Dim rngChartRange As Range
Dim rngTopLeft As Range
Dim rngBottomRight As Range
Dim lRowTop As Long
Dim lRowBottom As Long
Dim lColLeft As Long
Dim lColRight As Long

Set rngChartRange = Selection
Set oSheet = ActiveSheet

'put the range for the chart flush with the top right corner of the
visible range
'--------------------------------------------------------------------------------
TopRightAlignRange rngChartRange.Cells(rngChartRange.Columns.count)

lFirstRow = Selection.Cells(1).Row
lRowTop = Selection.Cells(1).Row
lRowBottom =
ActiveWindow.VisibleRange.Cells(ActiveWindow.VisibleRange.Cells.count).Row
lColLeft = ActiveWindow.ScrollColumn
lColRight = Selection.Cells(1).Column

Set rngTopLeft = Cells(lRowTop, lColLeft)
Set rngBottomRight = Cells(lRowBottom, lColRight)

'get patient's name for graph title
'----------------------------------
strName = Cells(lRowTop, 2) & " " & Cells(lRowTop, 3)

Application.ScreenUpdating = False

'clear the old charts
'---------------------
With ActiveSheet
For Each oChartObject In .ChartObjects
oChartObject.Delete
Next
End With

'build the chart
'---------------
Set oChart = oSheet.ChartObjects.Add(rngTopLeft.Left, _
rngTopLeft.Top, _
rngBottomRight.Left -
rngTopLeft.Left, _
rngBottomRight.Top -
rngTopLeft.Top).Chart

With oChart
.SetSourceData _
Source:=rngChartRange, _
PlotBy:=xlColumns
.ChartType = xlLine
.HasTitle = True
.ChartTitle.Characters.Text = strName
.HasLegend = False
.PlotArea.Left = 0
.PlotArea.Top = 0
.PlotArea.Width = .ChartArea.Width
.PlotArea.Height = .ChartArea.Height
.PlotArea.Interior.ColorIndex = 19
.ChartArea.Interior.ColorIndex = 34
.SeriesCollection(1).Border.ColorIndex = 3
.SeriesCollection(1).Border.Weight = xlMedium
End With

Application.ScreenUpdating = True

Exit Sub
ERROROUT:

MsgBox "There was an error making the chart" & _
vbCrLf & vbCrLf & _
Err.Description
On Error GoTo 0

End Sub


RBS
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Dynamic chart problem 1
Delete a chart 4
Place chart at specific cell location 2
Charts in VBA 1
how to make chart on selected range? 1
how to create chart by VBA coding? 6
Chart Size & Position 3
Chart error: plotting series data XY scatter plot 3

Top