Jumat, 26 September 2014

Re: [ExcelVBA] Re: Excel chart duplication

 

Dave, that’s pretty cool. Now I know how to set the chart location. ;)

From: "ExcelVBA@yahoogroups.com" <ExcelVBA@yahoogroups.com>
Reply-To: "ExcelVBA@yahoogroups.com" <ExcelVBA@yahoogroups.com>
Date: Friday, 26 September 2014 8:49 pm
To: "ExcelVBA@yahoogroups.com" <ExcelVBA@yahoogroups.com>
Subject: [ExcelVBA] Re: Excel chart duplication

 

Paul,

It wasn't clear if you also were requesting help on the chart part. I wrote this just in case. It works for me. There's no checking for "out of bounds" data (or anything else, for that matter).


Sub CreateCharts

    Dim XRange As String, YRange As String, WSName As String
    Dim i As Integer, j As Integer
   
    Const NumCharts As Integer = 4
    Const DataPointsPerChart As Integer = 60
    Const SeriesPerChart As Integer = 3
    Const FirstDataRow As Integer = 3
    Const XRow As Integer = 1
    Const LeftDataCol As Integer = 2
    Const HeaderCol As Integer = 1
   
    WSName = ActiveSheet.Name
    XRange = Cells(XRow, LeftDataCol).Address & ":" & _
          Cells(XRow, LeftDataCol).Offset(0, DataPointsPerChart - 1).Address
    For i = 0 To NumCharts - 1
        YRange = Cells(FirstDataRow + i, LeftDataCol).Address & ":" & _
          Cells(FirstDataRow + i, LeftDataCol).Offset(SeriesPerChart - 1, DataPointsPerChart - 1).Address
        Charts.Add
        ActiveChart.ChartType = xlXYScatterLinesNoMarkers
        ActiveChart.SetSourceData Source:=Sheets(WSName).Range(XRange & "," & YRange)
        ActiveChart.Location Where:=xlLocationAsObject, Name:=WSName
        For j = 1 To SeriesPerChart
            ActiveChart.SeriesCollection(j).Name = "=" & WSName & "!R" & _
              (FirstDataRow + i + j - 1) & "C" & HeaderCol
            Next j
        Worksheets(WSName).Cells(1, 1).Select 'done to deactivate created chart
        Next i
End Sub

Dave Gathmann

__._,_.___

Posted by: Paul Vermeulen <paul.vermeulen@vulcantech.com.au>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (4)
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------

.

__,_._,___

Tidak ada komentar:

Poskan Komentar