من این متد رو ساخته م و می خوام Axis Lable و Legend Entries رو به جای data Range بهش بدم.
با همین روش که عمل کرده م چطور میشه این کار رو کرد.
با همین روش که عمل کرده م چطور میشه این کار رو کرد.
کد:
Public Sub MakeChartLine(ByVal TableName As String)
'مقادير براي ساختن نمودار
'----------------------
Dim FrameToDirection, FrameToTop, FrameWidth, FrameHeight As Integer
'فاصله از دايرکشن
FrameToDirection = Range("ChartOptions[" & TableName & "]").Cells(3, 1)
'فاصله از بالا
FrameToTop = Range("ChartOptions[" & TableName & "]").Cells(4, 1)
'عرض
FrameWidth = Range("ChartOptions[" & TableName & "]").Cells(5, 1)
'ارتفاع
FrameHeight = Range("ChartOptions[" & TableName & "]").Cells(6, 1)
'ساختن چارت با تعيين مکان و اندازه
Dim MyChart As ChartObject
Set MyChart = ActiveSheet.ChartObjects.Add _
(FrameToDirection, FrameToTop, FrameWidth, FrameHeight)
'مقادير براي نوع و رنج داده و عنوان
'----------------------
'نوع نمودار
Dim TypeChart As Integer
TypeChart = Range("ChartOptions[" & TableName & "]").Cells(1, 1)
'عنوان نمودار
Dim TitleChart As String
TitleChart = Range("ChartOptions[" & TableName & "]").Cells(7, 1)
'ساختن نشاني رنج منبع
Dim FirsPart As String
FirsPart = ActiveSheet.ListObjects(TableName).ListColumns(1).DataBodyRange.Cells(1, 1).Address
Dim LastRow As String
LastRow = ActiveSheet.ListObjects(TableName).ListColumns(2).DataBodyRange.Count
Dim SecoundPart As String
SecoundPart = ActiveSheet.ListObjects(TableName).ListColumns(2).DataBodyRange.Cells(LastRow, 1).Address
'رنج منبع
Dim SourceChart As String
SourceChart = FirsPart & ":" & SecoundPart
'تعيين نوع نمودار و رنج داده و عنوان
MyChart.Chart.ChartWizard Source:=ActiveSheet.Range(SourceChart), _
Gallery:=TypeChart, Title:=TitleChart
'تعيين استايل چارت
MyChart.Chart.ChartStyle = Range("ChartOptions[" & TableName & "]").Cells(2, 1)
'بستن فهرست چارت از سمت دايرکشن
MyChart.Chart.SetElement (msoElementLegendNone)
'پاک کردن خط دوم
MyChart.Chart.SeriesCollection(1).Delete
'تعيين فونت براي همه چارت
With MyChart.Chart.ChartArea.Format.TextFrame2.TextRange.Font
.NameComplexScript = "B Mitra"
.NameFarEast = "B Mitra"
.Name = "B Mitra"
.Size = Range("ChartOptions[" & TableName & "]").Cells(9, 1)
End With
MyChart.Chart.Axes(xlCategory).HasTitle = True
MyChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Text = "سال"
'قابليت پرينت پيشفرض
If Range("ChartOptions[" & TableName & "]").Cells(11, 1) = 1 Then
Dim OldPrintAreaAddress As String
OldPrintAreaAddress = ActiveSheet.PageSetup.PrintArea
Dim ColNo As Integer
ColNo = Range(TableName).Columns.Count
Dim NewPrintAreaAddress As String
NewPrintAreaAddress = ActiveSheet.ListObjects(TableName).HeaderRowRange(ColNo).Offset(0, 1).Address _
& ":" & ActiveSheet.ListObjects(TableName).TotalsRowRange(1).Offset(36, 27).Address
ActiveSheet.PageSetup.PrintArea = OldPrintAreaAddress & "," & NewPrintAreaAddress
End If
End Sub
کامنت