เปลี่ยนสีพื้นหลังช่องตามรหัสสีที่เรากำหนด

[Kxess]

สวัสดีครับ
มีวิธีเปลี่ยนสีช่องแบบภาพตัวอย่างเป็น Continuous Forms แต่อยากให้แต่ละแถวที่ดึงข้อมูลออกมา มี 1 ช่องที่แสดงสี แต่สีจะไม่เหมือนกันเลย โดยโค้ดสีถูกเก็บไว้ในตารางนี้แหละ

โดยที่ไม่ใช้ Conditional Formatting Rules นะครับ เพราะสีเยอะมาก



ขอบคุณครับ

[สันติสุข]

สร้างไฟล์รูปภาพที่มีสีตามรหัสสี จะเป็น .png, .jpg, .bmp ก็ได้ ให้ขนาดใหญ่กว่าขนาดที่จะแสดงบนฟอร์มนิดหน่อย บันทึกไฟล์เหล่านี้ด้วยชื่อเดียวกับรหัสสี เช่น สีแดงก็มีชื่อไฟล์ว่า #FF0000.jpg เป็นต้น ในฟอร์มให้ใส่ Image control เพื่อแสดงรูปของสี โดยมี Control Source เป็น ="drive:\folder\" & [Hex] & "\.jpg" ครับ

[ปิ่นณรงค์]

ขอเพิ่มเติมอีกวิธีนะครับ


ที่ Module ใส่โค้ดนี้เข้าไป

โค๊ด: [Select]

Function MyHexColor(ByVal StrHex)
 
    If Len(StrHex) = 7 Then StrHex = Mid(StrHex, 2, 6)
    If Len(StrHex) = 6 Then

        num_array = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f")
        char1 = LCase(Mid(StrHex, 1, 1))
        char2 = LCase(Mid(StrHex, 2, 1))
        char3 = LCase(Mid(StrHex, 3, 1))
        char4 = LCase(Mid(StrHex, 4, 1))
        char5 = LCase(Mid(StrHex, 5, 1))
        char6 = LCase(Mid(StrHex, 6, 1))
        For i = 0 To 15
            If (char1 = num_array(i)) Then position1 = i
            If (char2 = num_array(i)) Then position2 = i
            If (char3 = num_array(i)) Then position3 = i
            If (char4 = num_array(i)) Then position4 = i
            If (char5 = num_array(i)) Then position5 = i
            If (char6 = num_array(i)) Then position6 = i
        Next
        If IsEmpty(position1) Or IsEmpty(position2) Or IsEmpty(position3) Or IsEmpty(position4) Or IsEmpty(position5) Or IsEmpty(position6) Then
            MyHexColor = -1
        Else
            MyHexColor = RGB(position1 * 16 + position2, position3 * 16 + position4, position5 * 16 + position6)
        End If
    Else
        MyHexColor = -1
    End If
End Function
ที่ฟอร์มกำหนดค่า ในส่วนของ Detail

โค๊ด: [Select]

Private Sub รายละเอียด_Paint()
If Not IsNull(Me.HEX) Then
    Me.COLOR.BackColor = MyHexColor(HEX)
    Else
    Me.COLOR.BackColor = MyHexColor("#FFFFFF")
 End If
End Sub


[UnKnown]

โดยทั่วไป Ms Access จะใช้โค้ดสีที่ต่างจากพวก > Hex / RGB / MS Access Color Values
แต่สามารถกำหนดใช้เป็น RGB ได้เช่น Me.TextBox.BackColor = RGB(255, 255, 255) เป็นต้น

ดังนั้นการที่จะนำโค้ดสีที่เป็น Hex มาใช้ได้ก็ต้องแปลงให้กลายไปเป็น RGB ก่อนด้วย Module ตัวอย่างของท่านปิ่นณรงค์
หรือ > https://stackoverflow.com/questions/40588470/setting-access-colour-codes-in-vba/50523021#50523021

โค๊ด: [Select]

Public Function Color_Hex_To_Long(strColor As String) As Long
    Dim iRed As Integer
    Dim iGreen As Integer
    Dim iBlue As Integer

    strColor = Replace(strColor, "#", "")
    strColor = Right("000000" & strColor, 6)
    iBlue = Val("&H" & Mid(strColor, 1, 2))
    iGreen = Val("&H" & Mid(strColor, 3, 2))
    iRed = Val("&H" & Mid(strColor, 5, 2))

    Color_Hex_To_Long = RGB(iRed, iGreen, iBlue)
End Function
หรือ > https://stackoverflow.com/questions/51292169/how-to-set-background-of-a-form-to-a-hexidecimal-color-in-ms-access-vba
ซึ่งวิธีนี้สามารถแปลงออกมาได้เลยไม่ต้องใช้โมดูล ผมจึงขอนำไฟล์ตัวอย่างของท่านปิ่นณรงค์มาทดสอบได้ผลตามไฟล์ตัวอย่างครับ

โค๊ด: [Select]

Me.Detail.BackColor = RGB("&H" & Left$(s, 2), _
                          "&H" & Mid$(s, 3, 2), _
                          "&H" & Right$(s, 2))

โค๊ด: [Select]

Me.Detail.BackColor = "&H" & Right$(s, 2) & Mid$(s, 3, 2) & Left$(s, 2)


[สันติสุข]

ไม่เคยรู้มาก่อนว่า OnPaint event สามารถควบคุมให้ Unbound Control ในแต่ละบรรทัดของ Continuous Form มีสีที่แตกต่างกันได้ .. ความรู้ใหม่ ขอบคุณครับ

[ปิ่นณรงค์]

ครับ อาจารย์ผมไปเจอวิธีนี้จากเว็บต่างประเทศ ตรงกำหนดสีกับ ข้อความครับ
เลยเอามาประยุกต์ใช้กับโค้ดนี้ครับ
ส่วนโค้ดนี้ผมไปค้นหาเจอจาก เว็บนอกครับ
มาแบ่งบันให้กับเพื่อนๆสมาชิกคับ โดยเอามาปรับโค้ด จาก excel เป็น Access ครับ 

[Kxess]

ขอบคุณมากคร้าบทุกท่าน   

[สันติสุข]

จากการทดลองเฉพาะกับ Textbox  ได้ข้อมูลเพิ่มเติมว่าสามารถใช้ OnPaint event เพื่อกำหนดค่า Property เหล่านี้ให้แตกต่างกันในแต่ละบรรทัดใน Continuous Form ได้นะครับ แต่ก็มีบางอันที่คุณสมบัติอาจเปลี่ยนไปจากที่กำหนดเมื่อเราคลิกไปที่ Textbox นั้นๆ แต่ถ้าไม่คลิกก็จะไม่มีปัญหาครับ อีกอย่างคือผมไม่ได้เช็คทุก Property นะครับ เช็คเฉพาะ Property ส่วนใหญ่ที่อยู่ในหมวด Format ใน Property Sheet เท่านั้น

Format
DecimalPlace
BackStyle
BackColor
BorderStyle
BorderWidth
BorderColor
SpecialEffect
ScrollBars
FontName
FontSize
TextAlign
FontWeight
FontUnderline
FontItalic
ForeColor
LineSpacing
TopMargin
BottomMargin
LeftMargin
RightMargin

[Kxess]

สวัสดีครับ
ผมไปหาโค้ดของสีที่ต้องการแล้วแปลงให้เป็น RGB แล้วครับ จะได้ไม่เสียเวลาแปลง
แต่กลับมีปัญหากับโค้ดง่าย ๆ

error 13 : type mismatch

โค๊ด: [Select]

Private Sub Detail_Paint()
 Me.MColor.BackColor = RGB(130, 119, 118)
End Sub
แค่นี้ก็ error เฉย
งงมากเลยครับ ตัวอย่างการใช้ก็ RGB() ก็ไม่น่าผิด แบบนี้เกิดจากอะไรครับ

ผมลองแนบไฟล์มาด้วย

[UnKnown]

*ในเทเบิ้ล "JPMA" มีชื่อคอลัมน์ RGB ซึ่งมันเป็นชื่อซ้ำกับตัวแปลไปแก้เป็นชื่ออื่นซะเป็นอันจบครับ

[Kxess]

แก้คอลัมน์ RGB ในตารางแล้วครับ
กลายเป็นว่า access มอง RGB เป็นฟิลด์ (ใช่มั้ยครับ)


edit:
ตอนนี้ทำได้แล้วครับ ผมใช้วิธีแปลง RGB เป็น Hex แล้วค่อยใช้โค้ดของคุณ UnKnown

โค๊ด: [Select]

Me.MxColor.BackColor = "&H" & Right$(strColor, 2) & Mid$(strColor, 3, 2) & Left$(strColor, 2)

เผื่อใครสนใจแปลง rgb to hex

โค๊ด: [Select]

Function RGBtoHEX(R As Byte, G As Byte, B As Byte) As String

    If R < 16 Then
        HEX1 = 0 & Hex(R)
    Else
        HEX1 = Hex(R)
    End If
   
    If G < 16 Then
        HEX2 = 0 & Hex(G)
    Else
        HEX2 = Hex(G)
    End If
   
    If B < 16 Then
        HEX3 = 0 & Hex(B)
    Else
        HEX3 = Hex(B)
    End If
   
    RGBtoHEX = HEX1 & HEX2 & HEX3

End Functionขอบคุณครับ

[UnKnown]

จากเดิมที่ -->

*ในเทเบิ้ล "JPMA" มีชื่อคอลัมน์ RGB ซึ่งมันเป็นชื่อซ้ำกับตัวแปลไปแก้เป็นชื่ออื่นซะเป็นอันจบครับ

เมื่อเรามีการแก้ชื่อคอลัมน์ไปนั้น ในฟอร์มที่มีการลิ้งเทเบิ้ลดังกล่าวจะต้องมาทำทีเป็นว่าสั่งลิ้งเทเบิ้ลนั้นใหม่/ที่กล่องข้อความที่มีการลิ้งคอลัมน์ก็เช่นกัน(แม้เราจะเห็นว่ามันเปลี่ยนไปอัตโนมัติแล้วแต่บางที่โปรแกรมมันเอ้อครับ)

ส่วนเรื่องแปลง RGB เป็น HEX แล้วมาใช้โค้ดแปลงกลับมาเป็น RGB อีกนั้นเพื่ออะไรครับ
คือจะบอกว่าที่ท่านใช้ให้อ่าน RGB จากกล่องข้อความมาเลยนั่นล่ะใช้ได้แล้วครับ

ไฟล์ที่ผ่านการแก้ไขชื่อเทเบิ้ลเป็น cRGB และแก้หน้าฟอร์มแล้ว & เปิดใช้สคลิปอ่านค่าสี RGB ของท่านด้วย

[Kxess]

ได้แล้วครับ โดยลบลิ้ง navigationbutton ที่มายังฟอร์มนี้ แล้วก็ลิ้งมาใหม่


ผมก็งงอยู่ตั้งนาน 
ขอบคุณคร้าบ