Activesheet shapes addchart select ошибка

Since you want the chart to be on a new sheet,
you have to change the macro’s «Sheet1» to new worksheet’s name,
The following macro should work for you, I have named the new worksheet as newWs

And fyi, your macro’s error message I believe is due to trying to creating 2 pivot table of the same name on «Sheet1» is not allowed.

He also like to know what to create pivotTable base on Selected Area, so I have done modification to the code.

Edited: I Assume you select 2 columns each time

Sub chart1()
 '
 ' chart1 Macro
 '

 '
Dim selectedSheetName As String
Dim newWs As Worksheet
Dim rangeName As String
Dim header1 As String
Dim header2 As String
header1 = ActiveSheet.Cells(1, Selection.Column).Value
header2 = ActiveSheet.Cells(1, Selection.Column + 1).Value
selectedSheetName = ActiveSheet.Name
rangeName = Selection.Address
Set newWs = Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    selectedSheetName & "!" & rangeName, Version:=xlPivotTableVersion12).CreatePivotTable _
    TableDestination:=newWs.Name & "!R3C1", TableName:="PivotTable1", DefaultVersion _
    :=xlPivotTableVersion12
newWs.Activate
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header1)
    .Orientation = xlRowField
    .Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
    .Orientation = xlColumnField
    .Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
    "PivotTable1").PivotFields(header2), "Count of answer1", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
    .Orientation = xlPageField
    .Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields(header2).Orientation = _
    xlHidden
With ActiveSheet.PivotTables("PivotTable1").PivotFields(header2)
    .Orientation = xlColumnField
    .Position = 1
End With
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(newWs.Name & "!$A$3:$D$6")
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range(newWs.Name & "!$A$3:$D$6")
ActiveChart.ChartType = xlColumnClustered
End Sub

1. 04-02-2015, 09:17 AM

   
   

   #1

   

   
   Registered User
   

   

   ---

   Error 1004: ActiveSheet.Shapes.AddChart.Select
   

   Hey there,

   i’m having a problem which drives me nuts. I have the following code:

   it worked fine, but all of the sudden, it stopped with the runtime error 1004 at the line «ActiveSheet.Shapes.AddChart.Select»

   so, whatever i try, i am not able to produce a chart anymore.
   anyone has any suggestions? i’ve look through a lot of other threads, but nothing worked for me…

   thanks a lot

   EDIT: Strange thing i just noticed: when i add a chart manually, and then run the script again, it works all fine…

   Last edited by andynewtovba; 04-02-2015 at 09:22 AM.

   ---

2. 04-02-2015, 10:59 AM

   
   

   #2

   Re: Error 1004: ActiveSheet.Shapes.AddChart.Select
   

   You should probably post all the code, not just where the problem starts.

   Last edited by skywriter; 04-02-2015 at 11:06 AM.

   As a reminder, once your original request has been fulfilled please mark this thread as SOLVED by going to the «Thread Tools» drop down list above your first post and choosing solved.

   If you are happy with my help, then please consider clicking the add reputation button in the lower left hand corner of this post.

   ---

3. 04-02-2015, 11:38 AM

   
   

   #3

   

   
   Registered User
   

   

   ---

   Re: Error 1004: ActiveSheet.Shapes.AddChart.Select
   

   sure, here you go 😛
   and thanks for the reply

   ---

4. 04-02-2015, 12:08 PM

   
   

   #4

   Re: Error 1004: ActiveSheet.Shapes.AddChart.Select
   

   Well I can’t figure it out, but I did find a lot of other threads and hits on Google when I typed «activesheet.shapes.addchart.select error 1004»

   Other Excel Forum Thread

   I’m not much of a chart expert, but it seems like this problem has been noticed by quite a few people, hopefully you will find an answer.

   Good Luck!!!

   ---

Private Sub Command1_Click()

Dim objExcel As Object

Set objExcel = CreateObject(«Excel.Application»)

With objExcel

    .Workbooks.Add

    .Worksheets(1).Activate

    For i = 1 To 30

        .Worksheets(1).Cells(i, 1) = i

        .Worksheets(1).Cells(i, 2) = Rnd(i) * 10

    Next

    .Charts.Add

    .Visible = True

    With .ActiveChart

        .ChartType = xlLine

        .SetSourceData Source:=Sheets(«Лист1»).Range(«B1:B30»), PlotBy:=xlColumns

        .Location Where:=xlLocationAsNewSheet

        .Axes(xlCategory, xlPrimary).HasTitle = True

        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = «время»

        .Axes(xlValue, xlPrimary).HasTitle = True

        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = «данные1»

        .HasTitle = True

        .HasAxis(xlCategory, xlPrimary) = True

        .HasAxis(xlValue, xlPrimary) = True

        .Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic

        ‘.HasMajorGridlines = True

        ‘.HasMinorGridlines = False

        With .Axes(xlValue)

            .HasMajorGridlines = True

            .HasMinorGridlines = False

        End With

        .HasDataTable = False

        .PlotArea.Select

    End With

    With .Selection.Border

        .ColorIndex = 16

        .Weight = xlThin

        .LineStyle = xlContinuous

    End With

    With .Selection.Interior

        .ColorIndex = 2

        .PatternColorIndex = 1

        .Pattern = xlSolid

    End With

    .ActiveChart.SeriesCollection(1).Select

    With .Selection.Border

        .ColorIndex = 41

        .LineStyle = xlContinuous

    End With

    With .Selection

        .MarkerBackgroundColorIndex = xlAutomatic

        .MarkerForegroundColorIndex = xlAutomatic

        .MarkerStyle = xlNone

        .Smooth = False

        .MarkerSize = 7

        .Shadow = False

    End With

    .ActiveChart.SeriesCollection(1).Select

    With .Selection.Border

        .ColorIndex = 57

        .LineStyle = xlContinuous

    End With

    With .Selection

        .MarkerBackgroundColorIndex = xlNone

        .MarkerForegroundColorIndex = xlNone

        .MarkerStyle = xlNone

        .Smooth = False

        .MarkerSize = 3

        .Shadow = False

    End With

    .ActiveChart.Axes(xlValue).MajorGridlines.Select

    With .Selection.Border

        .ColorIndex = 57

        .Weight = xlHairline

        .LineStyle = xlDot

    End With

    With .Selection.Border

        .ColorIndex = 57

        .Weight = xlHairline

        .LineStyle = xlDot

    End With

    .ActiveChart.Axes(xlCategory).Select

    With .Selection.TickLabels

        .Alignment = xlCenter

        .Offset = 100

        .ReadingOrder = xlContext

        .Orientation = xlUpward

    End With

      With .ActiveChart.Axes(xlCategory)

        .CrossesAt = 1

        .TickLabelSpacing = 1

         .TickMarkSpacing = 1

         .AxisBetweenCategories = True

        .ReversePlotOrder = False

    End With

    .ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=»График_1″

    .Sheets(«График_1»).Select

    .ActiveWindow.Zoom = 80

    End With

Set objExcel = Nothing

End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

Sub SWInsertChart(ByVal SWRow As Long, ByVal sParam As String)
 Dim YMin As Long, YMax As Long
 Dim sXValue As String, sYValue As String
 Dim p As Long, ws As Worksheet, ChO As ChartObject
 
    
    p = WhatObjIs
    
    With wbP(p).Worksheets("RoadMap").Activate
    uf_SelectWells
    If IsNumeric(.txb_SWYMin.Text) Then YMin = Val(.txb_SWYMin.Text)
    If IsNumeric(.txb_SWYMAx.Text) Then YMax = Val(.txb_SWYMAx.Text)
    End With
    sXValue = SWChartRange("SW", 1, 2, 1, NY + 1)
    sYValue = SWChartRange("SW", SWRow, 2, SWRow, NY + 1)
    
    With ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers)
     .Name = sParam & "_" & SWRow
    End With
    
    ActiveSheet.ChartObjects(sParam & "_" & SWRow).Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=SW!R" & SWRow & "C1"
    ActiveChart.FullSeriesCollection(1).XValues = sXValue
    ActiveChart.FullSeriesCollection(1).Values = sYValue
    If YMin > YMax Then
     ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
     ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
    Else
     ActiveChart.Axes(xlCategory).MinimumScale = YMin
     ActiveChart.Axes(xlCategory).MaximumScale = YMax
    End If
   
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(2).Name = "Copy"
    ActiveChart.FullSeriesCollection(2).XValues = sXValue
    sYValue = SWChartRange("SW", SWRow + 1, 2, SWRow + 1, NY + 1)
    ActiveChart.FullSeriesCollection(2).Values = sYValue
   
 
End Sub

1
2
3

    For Each Myseries In ActiveChart.SeriesCollection
     Myseries.Delete
    Next

1

ActiveSheet.ChartObjects(NameOfChartObject).Activate

1
2
3
4
5
6
7
8
9

 Dim MySs As Object
 
   ActiveSheet.ChartObjects(NameOfChartObject).Activate
    
    On Error Resume Next
    For Each MySs In ActiveChart.SeriesCollection
     MySs.Delete
     If Err.Number <> 0 Then Exit For
    Next

0