Excel用户只能通过选择颜色填充单元格

snz8szmq 于 2023-03-24 发布在其他

关注(0)|答案(2)|浏览(145)

我试图使它选择一组数据中的单元格，只能用4种预先选择的颜色中的1种来填充。有点像一个下拉菜单列表，但用于填充颜色。
我们有一个大约9人的团队同时在一个excel文件中工作。时间是至关重要的，我们之间的一些交流和输入是用选择数据的填充颜色。
由于有许多颜色可用，我们可以得到一个奇怪的色调组合，阻碍我们的生产。
有没有办法将填充颜色限制在预先选择的组中？
我只研究了数据验证下拉菜单，因为这是我有限的知识所能想到的唯一事情。
随着数据变量和形式的范围，还没有找到一种方法，条件格式将是可能的。与我们的过程中，数据可以保持不变，但我们与颜色的数据是否有效，并准备去沟通。用户需要能够改变单元格的颜色任意。
不幸的是，我还没有接近我一直在寻找的东西。

excel

来源：https://stackoverflow.com/questions/75816914/excel-users-only-able-to-fill-cell-from-select-colors

2条答案

按热度按时间

a0x5cqrl1#

把这个放在工作表模块中：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim StrColorbox01Name As String
    Dim StrColorbox02Name As String
    Dim StrColorbox03Name As String
    Dim StrColorbox04Name As String
    Dim StrActivatorName As String
    Dim ObjColorbox01 As Object
    Dim ObjColorbox02 As Object
    Dim ObjColorbox03 As Object
    Dim ObjColorbox04 As Object
    Dim ObjActivator As Object
    Dim DblSize As Double
    
    
    StrColorbox01Name = "ObjCB01"
    StrColorbox02Name = "ObjCB02"
    StrColorbox03Name = "ObjCB03"
    StrColorbox04Name = "ObjCB04"
    
    StrActivatorName = "ObjActivator"
    
    DblSize = 15
    
    On Error Resume Next
    Set ObjColorbox01 = Me.Shapes(StrColorbox01Name)
    Set ObjColorbox02 = Me.Shapes(StrColorbox02Name)
    Set ObjColorbox03 = Me.Shapes(StrColorbox03Name)
    Set ObjColorbox04 = Me.Shapes(StrColorbox04Name)
    
    Set ObjActivator = Me.Shapes(StrActivatorName)
    On Error GoTo 0
    
    If ObjColorbox01 Is Nothing Or ObjColorbox02 Is Nothing Or ObjColorbox03 Is Nothing Or ObjColorbox04 Is Nothing Or ObjActivator Is Nothing Then
        
        On Error Resume Next
        ObjColorbox01.Delete
        ObjColorbox02.Delete
        ObjColorbox03.Delete
        ObjColorbox04.Delete
        ObjActivator.Delete
        On Error GoTo 0
        
        With Me.Shapes
            
            Set ObjColorbox01 = .AddShape(msoShapeRectangle, 0, 0, DblSize, DblSize)
            Set ObjColorbox02 = .AddShape(msoShapeRectangle, ObjColorbox01.Left + ObjColorbox01.Width, ObjColorbox01.Top, ObjColorbox01.Width, ObjColorbox01.Height)
            Set ObjColorbox03 = .AddShape(msoShapeRectangle, ObjColorbox02.Left + ObjColorbox02.Width, ObjColorbox02.Top, ObjColorbox02.Width, ObjColorbox02.Height)
            Set ObjColorbox04 = .AddShape(msoShapeRectangle, ObjColorbox03.Left + ObjColorbox03.Width, ObjColorbox03.Top, ObjColorbox03.Width, ObjColorbox03.Height)
            Set ObjActivator = .AddShape(msoShapeRectangle, ObjColorbox04.Left + ObjColorbox04.Width, ObjColorbox04.Top, ObjColorbox04.Width, ObjColorbox04.Height)
            
            ObjColorbox01.Name = StrColorbox01Name
            ObjColorbox02.Name = StrColorbox02Name
            ObjColorbox03.Name = StrColorbox03Name
            ObjColorbox04.Name = StrColorbox04Name
            ObjActivator.Name = StrActivatorName
            
            ObjColorbox01.DrawingObject.Interior.Color = RGB(255, 0, 0)
            ObjColorbox02.DrawingObject.Interior.Color = RGB(0, 255, 0)
            ObjColorbox03.DrawingObject.Interior.Color = RGB(0, 0, 255)
            ObjColorbox04.DrawingObject.Interior.Color = RGB(255, 255, 0)
            ObjActivator.DrawingObject.Interior.Color = RGB(127, 127, 127)
            
            ObjColorbox01.OnAction = "SubColor01"
            ObjColorbox02.OnAction = "SubColor02"
            ObjColorbox03.OnAction = "SubColor03"
            ObjColorbox04.OnAction = "SubColor04"
            
            ObjActivator.OnAction = "SubColorPaletteOnOff"
            
            ObjActivator.OLEFormat.Object.Caption = "ON"
            
            With ObjActivator.OLEFormat.Object.ShapeRange.TextFrame2
                .VerticalAnchor = msoAnchorMiddle
                .HorizontalAnchor = msoAnchorNone
                .MarginLeft = 0
                .MarginRight = 0
                .MarginTop = 0
                .MarginBottom = 0
                .WordWrap = msoFalse
                .AutoSize = msoAutoSizeShapeToFitText
            End With
            
        End With
        
    Else
        
        Set ObjColorbox02 = Me.Shapes(StrColorbox02Name)
        Set ObjColorbox03 = Me.Shapes(StrColorbox03Name)
        Set ObjColorbox04 = Me.Shapes(StrColorbox04Name)
        
        ObjColorbox01.Height = DblSize
        ObjColorbox01.Width = DblSize
        
        ObjColorbox02.Height = ObjColorbox01.Height
        ObjColorbox02.Width = ObjColorbox01.Width
        ObjColorbox03.Height = ObjColorbox01.Height
        ObjColorbox03.Width = ObjColorbox01.Width
        ObjColorbox04.Height = ObjColorbox01.Height
        ObjColorbox04.Width = ObjColorbox01.Width
        
    End If
    
    
    If ObjActivator.OLEFormat.Object.Caption = "ON" Then
        
        ObjColorbox01.Top = Target.Cells(1, 1).Top + Target.Cells(1, 1).Height
        ObjColorbox01.Left = Target.Cells(1, 1).Left + Target.Cells(1, 1).Width
        
        ObjColorbox02.Top = ObjColorbox01.Top
        ObjColorbox02.Left = ObjColorbox01.Left + ObjColorbox01.Width
        ObjColorbox03.Top = ObjColorbox02.Top
        ObjColorbox03.Left = ObjColorbox02.Left + ObjColorbox02.Width
        ObjColorbox04.Top = ObjColorbox03.Top
        ObjColorbox04.Left = ObjColorbox03.Left + ObjColorbox03.Width
        ObjActivator.Top = ObjColorbox04.Top
        ObjActivator.Left = ObjColorbox04.Left + ObjColorbox04.Width
        
    End If
    
End Sub

把它放在一个公共模块中：

Sub SubColor01()
    
    If ActiveSheet.Shapes("ObjActivator").OLEFormat.Object.Caption = "ON" Then
        
        Selection.Interior.Color = ActiveSheet.Shapes("ObjCB01").DrawingObject.Interior.Color
        
    End If
    
End Sub
Sub SubColor02()
    
    If ActiveSheet.Shapes("ObjActivator").OLEFormat.Object.Caption = "ON" Then
        
        Selection.Interior.Color = ActiveSheet.Shapes("ObjCB02").DrawingObject.Interior.Color
        
    End If
    
End Sub
Sub SubColor03()
    
    If ActiveSheet.Shapes("ObjActivator").OLEFormat.Object.Caption = "ON" Then
        
        Selection.Interior.Color = ActiveSheet.Shapes("ObjCB03").DrawingObject.Interior.Color
        
    End If
    
End Sub
Sub SubColor04()
    
    If ActiveSheet.Shapes("ObjActivator").OLEFormat.Object.Caption = "ON" Then
        
        Selection.Interior.Color = ActiveSheet.Shapes("ObjCB04").DrawingObject.Interior.Color
        
    End If
    
End Sub
Sub SubColorPaletteOnOff()
    
    Dim StrColorbox01Name As String
    Dim StrColorbox02Name As String
    Dim StrColorbox03Name As String
    Dim StrColorbox04Name As String
    Dim StrActivatorName As String
    Dim ObjColorbox01 As Object
    Dim ObjColorbox02 As Object
    Dim ObjColorbox03 As Object
    Dim ObjColorbox04 As Object
    Dim ObjActivator As Object
    Dim RngRestingRange As Range
    
    StrColorbox01Name = "ObjCB01"
    StrColorbox02Name = "ObjCB02"
    StrColorbox03Name = "ObjCB03"
    StrColorbox04Name = "ObjCB04"
    
    With ActiveSheet
        Set ObjActivator = .Shapes("ObjActivator")
        Set ObjColorbox01 = .Shapes(StrColorbox01Name)
        Set ObjColorbox02 = .Shapes(StrColorbox02Name)
        Set ObjColorbox03 = .Shapes(StrColorbox03Name)
        Set ObjColorbox04 = .Shapes(StrColorbox04Name)
        Set RngRestingRange = .Range("A1")
    End With
        
    With ObjActivator.OLEFormat.Object
    
        Select Case .Caption
            Case Is = "ON"
                .Caption = "OFF"
                
                ObjColorbox01.Top = RngRestingRange.Cells(1, 1).Top
                ObjColorbox01.Left = RngRestingRange.Cells(1, 1).Left
                
                ObjColorbox02.Top = ObjColorbox01.Top
                ObjColorbox02.Left = ObjColorbox01.Left + ObjColorbox01.Width
                ObjColorbox03.Top = ObjColorbox02.Top
                ObjColorbox03.Left = ObjColorbox02.Left + ObjColorbox02.Width
                ObjColorbox04.Top = ObjColorbox03.Top
                ObjColorbox04.Left = ObjColorbox03.Left + ObjColorbox03.Width
                ObjActivator.Top = ObjColorbox04.Top
                ObjActivator.Left = ObjColorbox04.Left + ObjColorbox04.Width
                
            Case Is = "OFF"
                .Caption = "ON"
            Case Else
                .Caption = "OFF"
        End Select
        
    End With
    
End Sub

主要优点：您可以选择多个范围，因为你喜欢和改变他们的填充只是与点击你需要选择所需的范围加一个颜色。

赞(0）回复(0）举报 2023-03-24

anhgbhbe2#

对颜色为单词的列使用数据验证，然后使用条件格式设置颜色。