نمایش نتایج: از شماره 1 تا 2 , از مجموع 2

موضوع: نمایش نمودار در یک سلول

  1. #1


    آخرین بازدید
    2013/01/23
    تاریخ عضویت
    May 2010
    نوشته ها
    7
    امتیاز
    0
    سپاس
    0
    سپاس شده
    0 در 0 پست
    تعیین سطح نشده است

    نمایش نمودار در یک سلول

    با سلام ب دوستان عزیز
    شاید تا به حال به فکر افتاده باشید که در یک سل نمودار مربوط به چندین سل مجاور را داشته باشید.
    این امکان در اکسل 2007 وجود داره ولی در 2003 باید از طریق نوشتن کد انجام بگیره و یا بصورت add ins ساخته شده و استفاده بشه.
    من این کد رو دانلود کردم و برای شما هم میگذارم امیدوارم که مفید باشد.


    Function LineChart(Points As Range, Color As Long) As String
    Const cMargin = 2
    Dim rng As Range, arr() As Variant, i As Long, j As Long, k As Long
    Dim dblMin As Double, dblMax As Double, shp As Shape

    Set rng = Application.Caller

    ShapeDelete rng

    For i = 1 To Points.Count
    If j = 0 Then
    j = i
    ElseIf Points(, j) > Points(, i) Then
    j = i
    End If
    If k = 0 Then
    k = i
    ElseIf Points(, k) < Points(, i) Then
    k = i
    End If
    Next
    dblMin = Points(, j)
    dblMax = Points(, k)

    With rng.Worksheet.Shapes
    For i = 0 To Points.Count - 2
    Set shp = .AddLine( _
    cMargin + rng.Left + (i * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
    cMargin + rng.Top + (dblMax - Points(, i + 1)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin), _
    cMargin + rng.Left + ((i + 1) * (rng.Width - (cMargin * 2)) / (Points.Count - 1)), _
    cMargin + rng.Top + (dblMax - Points(, i + 2)) * (rng.Height - (cMargin * 2)) / (dblMax - dblMin))

    On Error Resume Next
    j = 0: j = UBound(arr) + 1
    On Error GoTo 0
    ReDim Preserve arr(j)
    arr(j) = shp.Name
    Next

    With rng.Worksheet.Shapes.Range(arr)
    .Group

    If Color > 0 Then .Line.ForeColor.RGB = Color Else .Line.ForeColor.SchemeColor = -Color
    End With

    End With

    LineChart = ""
    End Function

    Sub ShapeDelete(rngSelect As Range)
    Dim rng As Range, shp As Shape, blnDelete As Boolean

    For Each shp In rngSelect.Worksheet.Shapes
    blnDelete = False
    Set rng = Intersect(Range(shp.TopLeftCell, shp.BottomRightCell), rngSelect)
    If Not rng Is Nothing Then
    If rng.Address = Range(shp.TopLeftCell, shp.BottomRightCell).Address Then blnDelete = True
    End If

    If blnDelete Then shp.Delete
    Next
    End Sub

    [attachment=54]
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.
    فايل هاي پيوست شده فايل هاي پيوست شده

  2.  

  3. #2


    آخرین بازدید
    2015/03/28
    تاریخ عضویت
    March 2010
    نوشته ها
    113
    امتیاز
    15
    سپاس
    8
    سپاس شده
    17 در 13 پست
    تعیین سطح نشده است

    RE: نمایش نمودار در یک سلول

    البته این امکان جزء قابلیتهای ورژن 2010 هستش و در ورژن 2007 هم همچین امکانی وجود نداره


اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

انجمن اكسل ايران , اكسل , اكسس , سوال و جواب اكسل , سوال اكسس , انجمن اكسل ايران , توابع اكسل, آموزش اكسل, آموزش اكسس, VBA, ويژوال بيسيك

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است
با ما در تماس باشيد