پرفروش ترين
برترين
آخرين محصولات فروشگاه
فایل الکترونیکی آموزش اکسل پیشرفته ۲۰۱۰
آموزش ایجاد فایل چندکاربره با سطح دسترسی مشخص
نمایش نتایج: از شماره 1 تا 7 , از مجموع 7

موضوع: هزار و یک شب اکسل - شب چهل و دوم پیدا کردن کد رنگ ها در اکسل 56 Excel ColorIndex Colors

  1. #1


    آخرین بازدید
    2022/06/26
    تاریخ عضویت
    January 2013
    محل سکونت
    شیراز
    نوشته ها
    1,199
    امتیاز
    3248
    سپاس
    1,570
    سپاس شده
    3,182 در 795 پست
    سطح اکسل
    84.00 %

    Exclamation هزار و یک شب اکسل - شب چهل و دوم پیدا کردن کد رنگ ها در اکسل 56 Excel ColorIndex Colors

    با درود
    از همه دوستانی که این مدت نبودم معذرت میخوام . خوب حالم خوب نبود دعوام نکنین حاله دیگه خراب میشه. خوب بریم سر قصه امشب
    شاید برای همه ما پیش اومده باشه که بخواهیم کد رنگ ها و فونت ها و ...... رو در ویژوال به درستی به کار ببریم و از کد اون مطلع نباشیم . کد زیر یه شیت براتون ایجاد میکنه و مشکلتون رو حل میکنه .


    کد:
    Sub colors()
    
      ActiveWorkbook.Sheets.Add
    
      Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        ActiveSheet.Range("A1:H1").Value = Array("interior", "font", "HTML", "bgcolor=", "Red", "Green", "Blue", "Color")
        Range("E1").Font.ColorIndex = 3
        Range("F1").Font.ColorIndex = 4
        Range("G1").Font.ColorIndex = 5
        Range("A2").Font.ColorIndex = 2
        Range("D2").Font.ColorIndex = 2
        Range("H2").Font.ColorIndex = 2
    Dim i As Long
    Dim str0 As String, str As String
    For i = 1 To 56
      Cells(i + 1, 1).Interior.ColorIndex = i
      Cells(i + 1, 1).Value = "[Color " & i & "]"
      Cells(i + 1, 2).Font.ColorIndex = i
      Cells(i + 1, 2).Value = "[Color " & i & "]"
      str0 = Right("000000" & Hex(Cells(i + 1, 1).Interior.Color), 6)
      'Excel shows nibbles in reverse order so make it as RGB
      str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
      'generating 2 columns in the HTML table
      Cells(i + 1, 3) = "#" & str
       Cells(i + 1, 4) = "#" & str
        Cells(i + 1, 4).Interior.ColorIndex = i
      Cells(i + 1, 5).Formula = "=Hex2dec(""" & Right(str0, 2) & """)"
      Cells(i + 1, 6).Formula = "=Hex2dec(""" & Mid(str0, 3, 2) & """)"
      Cells(i + 1, 7).Formula = "=Hex2dec(""" & Left(str0, 2) & """)"
      Cells(i + 1, 8) = "[Color " & i & "]"
    Next i
     Range("H2").Value = "vbBlack"
        Range("H2").Interior.Color = vbBlack
        Range("H3").Value = "vbWhite"
        Range("H3").Interior.Color = vbWhite
        Range("H4").Value = "vbRed"
        Range("H4").Interior.Color = vbRed
        Range("H5").Value = "vbGreen"
        Range("H5").Interior.Color = vbGreen
        Range("H6").Value = "vbBlue"
        Range("H6").Interior.Color = vbBlue
        Range("H7").Value = "vbYellow"
        Range("H7").Interior.Color = vbYellow
        Range("H8").Value = "vbMagenta"
        Range("H8").Interior.Color = vbMagenta
        Range("H9").Value = "vbCyan"
        Range("H9").Interior.Color = vbCyan
    done:
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End Sub
    خوب خوب با این اعداد اشنا بشین . یه ماژوا ایجاد کنید . دیگه توضیح نمیدم قبلا روش ایجاد ماژول تو محیط VBA گفته شد . بعدش کد های زیر رو در انجا کپی و RUN کنید ( F5 )

    در ادامه شب های بعد در همین تاپیک با کد نویسی با این اعداد بیشتر اشنا میشیم.
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.
    در پناه خداوندگار ایران زمین باشید و پیروز


  2.  

  3. #2


    آخرین بازدید
    2022/12/05
    تاریخ عضویت
    October 2011
    محل سکونت
    مشهد
    نوشته ها
    4,399
    امتیاز
    12759
    سپاس
    4,642
    سپاس شده
    12,135 در 3,224 پست
    سطح اکسل
    70.00 %

    تشکر از مهندس اسماعیلی عزیز

    امین جان به نظرت برای تشخیص رنگ های کاندیشنال فرمتینگ در ورژن های بالاتر از 2003 راهی هست؟




  4. #3


    آخرین بازدید
    2022/06/26
    تاریخ عضویت
    January 2013
    محل سکونت
    شیراز
    نوشته ها
    1,199
    امتیاز
    3248
    سپاس
    1,570
    سپاس شده
    3,182 در 795 پست
    سطح اکسل
    84.00 %

    با درود
    کد زیر رو من گشتم و تو 2010 تست کردم جواب داد فقط نقصش تو Conditional formating رو String هست مهدی فک کنم . رو اعداد که خوب جواب داد
    کد:
    ' Arguments
    ' ----------------
    ' Cell - Required Range, not a String value, for a **single** cell
    '
    ' CellInterior - Optional Boolean (Default = True)
    '                True makes function return cell's Interior Color or ColorIndex based on
    '                the ReturnColorIndex argument False makes function return Font's Color or
    '                ColorIndex based on the ReturnColorIndex argument
    '
    ' ReturnColorIndex - Optional Boolean (Default = True)
    '                    True makes function return the ColorIndex for the cell property determined
    '                    by the CellInterior argument False make function return the Color for the
    '                    cell property determined by the CellInterior argument
    '
    Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
                            Optional ReturnColorIndex As Long = True) As Long
      Dim X As Long, Test As Boolean, CurrentCell As String
      If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
      CurrentCell = ActiveCell.Address
      For X = 1 To Cell.FormatConditions.Count
        With Cell.FormatConditions(X)
          If .Type = xlCellValue Then
            Select Case .Operator
              Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
              Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
              Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
              Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
              Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
              Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
              Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
              Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
            End Select
          ElseIf .Type = xlExpression Then
            Application.ScreenUpdating = False
            Cell.Select
            Test = Evaluate(.Formula1)
            Range(CurrentCell).Select
            Application.ScreenUpdating = True
          End If
          If Test Then
            If CellInterior Then
              DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
            Else
              DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
            End If
            Exit Function
          End If
        End With
      Next
      If CellInterior Then
        DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
      Else
        DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
      End If
    End Function
    هر چن اینم نقص هایی داره اما چک کن تا ببینم چیز بهتر چی چیدا میشه

    با ددرود
    ویرایش توسط امين اسماعيلي : 2014/05/05 در ساعت 15:33
    در پناه خداوندگار ایران زمین باشید و پیروز

  5. سپاس ها (3)


  6. #4


    آخرین بازدید
    2022/06/26
    تاریخ عضویت
    January 2013
    محل سکونت
    شیراز
    نوشته ها
    1,199
    امتیاز
    3248
    سپاس
    1,570
    سپاس شده
    3,182 در 795 پست
    سطح اکسل
    84.00 %

    با درود
    داداش
    این کدو تست کن فک کنم بهتر عمل میکنه و تو تکست هم جواب داد

    کد:
    '---------------------------------------------------------------------
    Public Function CFColorindex(rng As Range)
    '---------------------------------------------------------------------
    Dim oFC As FormatCondition
    Dim sF1 As String
    Dim iRow As Long
    Dim iColumn As Long
    
       Set rng = rng(1, 1)
       If rng.FormatConditions.Count > 0 Then
          For Each oFC In rng.FormatConditions
             If oFC.Type = xlCellValue Then
                Select Case oFC.Operator
                   Case xlEqual
                      CFColorindex = rng.Value = oFC.Formula1
                   Case xlNotEqual
                      CFColorindex = rng.Value <> oFC.Formula1
                   Case xlGreater
                      CFColorindex = rng.Value > oFC.Formula1
                   Case xlGreaterEqual
                      CFColorindex = rng.Value >= oFC.Formula1
                   Case xlLess
                      CFColorindex = rng.Value < oFC.Formula1
                   Case xlLessEqual
                      CFColorindex = rng.Value <= oFC.Formula1
                   Case xlBetween
                      CFColorindex = (rng.Value >= oFC.Formula1 And _
                                 rng.Value <= oFC.Formula2)
                   Case xlNotBetween
                      CFColorindex = (rng.Value < oFC.Formula1 Or _
                                 rng.Value > oFC.Formula2)
                End Select
             Else
                 're-adjust the formula back to the formula that applies
                 'to the cell as relative formulae adjust to the activecell
                With Application
                   iRow = rng.row
                   iColumn = rng.Column
                   sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
                   sF1 = .Substitute(sF1, "COLUMN()", iColumn)
                   sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
                   sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
                End With
                CFColorindex = rng.Parent.Evaluate(sF1)
             End If
    
             If CFColorindex Then
                If Not IsNull(oFC.Interior.ColorIndex) Then
                   CFColorindex = oFC.Interior.ColorIndex
                   Exit Function
                End If
             End If
         Next oFC
       End If 'rng.FormatConditions.Count > 0
    
    End Function
    در پناه خداوندگار ایران زمین باشید و پیروز


  7. #5


    آخرین بازدید
    2022/12/05
    تاریخ عضویت
    October 2011
    محل سکونت
    مشهد
    نوشته ها
    4,399
    امتیاز
    12759
    سپاس
    4,642
    سپاس شده
    12,135 در 3,224 پست
    سطح اکسل
    70.00 %

    با روش های مختلف تست کردم ظاهرا کد پست 3 بهتر جواب میده کد پست 4 ایراد داره



  8. سپاس ها (1)


  9. #6


    آخرین بازدید
    2022/12/05
    تاریخ عضویت
    October 2011
    محل سکونت
    مشهد
    نوشته ها
    4,399
    امتیاز
    12759
    سپاس
    4,642
    سپاس شده
    12,135 در 3,224 پست
    سطح اکسل
    70.00 %

    متاسفانه کد اولی هم درست جواب نمیده فایل رو پیوست کردم
    فايل هاي پيوست شده فايل هاي پيوست شده




  10. #7


    آخرین بازدید
    2022/06/26
    تاریخ عضویت
    January 2013
    محل سکونت
    شیراز
    نوشته ها
    1,199
    امتیاز
    3248
    سپاس
    1,570
    سپاس شده
    3,182 در 795 پست
    سطح اکسل
    84.00 %

    با درود
    مهدی ببین تو Top رنک که میخوای با فرمول نمیتونی به جواب برسی . از طریق فرمول کاندیشن ببندی

    فایل زیر رو من میزارم برات هر چی کد دیدم برات گذاشتم

    در ضمن لینک زیر رو یه نگاهی بنداز
    http://www.xldynamic.com/source/xld.CFConditions.html
    فايل هاي پيوست شده فايل هاي پيوست شده
    • نوع فایل: xlsm Color.xlsm اطلاعات (31.5 کیلو بایت, 21 نمایش)
    در پناه خداوندگار ایران زمین باشید و پیروز



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

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

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

موضوعات مشابه

  1. 12 گام برای پیشرفت در excel و کار
    توسط ~M*E*H*D*I~ در انجمن تالار آموزش اکسل
    پاسخ ها: 2
    آخرين نوشته: 2014/09/24, 23:46
  2. پاسخ ها: 5
    آخرين نوشته: 2014/04/30, 03:46
  3. [حل شده] باز نشدن VB در Excel
    توسط musicbox1970 در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 3
    آخرين نوشته: 2013/04/15, 08:08
  4. اجزاء پنجره Excel
    توسط a3man در انجمن آموزش ساير موضوعات در اكسل
    پاسخ ها: 0
    آخرين نوشته: 2011/08/11, 11:24

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

calculator ویژوال بیسیک اکسس

انتخاب رنگ بر اساس کد هگزا در اکسل

کلمات کلیدی این موضوع

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

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

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