امتیاز موضوع:
  • 0 رأی - میانگین امتیازات: 0
  • 1
  • 2
  • 3
  • 4
  • 5
دادن Axis Lable و Legend Entries به جای Data Range
نویسنده پیام
eppagh آفلاین
كاربر تک ستاره
*

ارسال‌ها: 45
موضوع‌ها: 26
تاریخ عضویت: تير ۱۳۹۳

تشکرها : 5
( 2 تشکر در 2 ارسال )
ارسال: #1
دادن Axis Lable و Legend Entries به جای Data Range
من این متد رو ساخته م و می خوام 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

At باتشکر
(آخرین ویرایش در این ارسال: ۲۸-دى-۱۳۹۳, ۰۵:۱۴:۰۸، توسط behzady.)
۲۷-دى-۱۳۹۳, ۱۴:۵۳:۴۸
ارسال‌ها
پاسخ


موضوعات مرتبط با این موضوع...
موضوع نویسنده پاسخ بازدید آخرین ارسال
  قرار دادن خروجی دستور sql در یک متغیر sepahbod 1 3,971 ۱۶-آذر-۱۳۹۲, ۲۱:۳۳:۳۳
آخرین ارسال: hmiranled
  پیام جهت اطلاع دادن sepahbod 4 4,322 ۱۲-شهریور-۱۳۹۲, ۱۵:۲۹:۵۱
آخرین ارسال: sepahbod
  جمع زدن دو فیلد و قرار دادن در فیلد دیگر در VB6 mohsen0025 7 7,477 ۰۲-شهریور-۱۳۹۲, ۱۱:۵۱:۴۶
آخرین ارسال: mohsen0025
  نحوه قرار دادن فایل فلش و عکس با پسوندpng؟ student-p 10 11,322 ۱۲-دى-۱۳۹۱, ۱۲:۵۱:۱۶
آخرین ارسال: student-p
Question [سوال] ناریخ شمسی در Data Reaport arezoobandar 1 3,209 ۱۴-فروردین-۱۳۹۱, ۰۱:۱۰:۲۶
آخرین ارسال: Ghoghnus
Question [سوال] استفاده از شیء data برای جستجوی پیشرفته در database Hamidreza97 0 2,382 ۰۳-شهریور-۱۳۹۰, ۲۳:۳۵:۴۹
آخرین ارسال: Hamidreza97
  [سوال] قرار دادن برنامه در حالت Startup HamedFaa 4 7,048 ۳۱-تير-۱۳۹۰, ۰۹:۲۵:۰۷
آخرین ارسال: Shayani
Wink [ایرانویجی] حرکت دادن فرمهای بدون نوار عنوان! [Moosa] 1 3,759 ۰۷-خرداد-۱۳۹۰, ۰۲:۴۶:۱۰
آخرین ارسال: zirak
  افکت دادن به فرم [Moosa] 0 2,337 ۱۱-اردیبهشت-۱۳۹۰, ۱۹:۰۳:۵۴
آخرین ارسال: [Moosa]
  طریقه جواب دادن به chapta و ورود به روم djahang 2 2,696 ۳۰-فروردین-۱۳۹۰, ۰۳:۰۹:۵۵
آخرین ارسال: HamedFaa

پرش به انجمن:


کاربرانِ درحال بازدید از این موضوع: 1 مهمان

صفحه‌ی تماس | IranVig | بازگشت به بالا | | بایگانی | پیوند سایتی RSS