excel-vba
Skapa en rullgardinsmeny i det aktiva arbetsbladet med en kombinationsruta

Introduktion

Jimi Hendrix Menu

I allmänhet placeras koden i modulet på ett ark.

Detta är händelsen Worksheet_SelectionChange, som avfyras varje gång en annan cell väljs i det aktiva arket. Du kan välja "Worksheet" från den första rullgardinsmenyn ovanför kodfönstret och "Selection_Change" från rullgardinsmenyn bredvid. I det här fallet omdirigeras koden till Combo Boxs kod varje gång du aktiverar en cell.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   ComboBox1_Change
   
End Sub

Här kodas rutinen till ComboBox som standard till händelsen Change. I det finns det en fast matris, fylld med alla alternativ. Inte CLEAR-alternativet i den sista positionen, som kommer att användas för att rensa innehållet i en cell. Matrisen överlämnas sedan till Combo Box och överförs till rutinen som gör arbetet.

Private Sub ComboBox1_Change()

Dim myarray(0 To 5)
    myarray(0) = "Hey Joe"
    myarray(1) = "Little Wing"
    myarray(2) = "Voodoo Child"
    myarray(3) = "Purple Haze"
    myarray(4) = "The Wind Cries Mary"
    myarray(5) = "CLEAR"
    
    With ComboBox1
        .List = myarray()
    End With

    FillACell myarray()

End Sub

Matrisen överförs till rutinen som fyller cellerna med låtenamnet eller nullvärdet för att tömma dem. Först ges en heltalvariabel värdet för positionen för valet som användaren gör. Sedan flyttas Combo Box till det övre Vänster hörnet av cellen som användaren aktiverar och dess dimensioner justeras för att göra upplevelsen mer flytande. Den aktiva cellen tilldelas sedan värdet i positionen i heltalvariabeln, som spårar användarvalet. Om användaren väljer CLEAR från alternativen töms cellen.

Hela rutinen upprepas för varje vald cell.

Sub FillACell(MyArray As Variant)

Dim n As Integer

n = ComboBox1.ListIndex

ComboBox1.Left = ActiveCell.Left
ComboBox1.Top = ActiveCell.Top
Columns(ActiveCell.Column).ColumnWidth = ComboBox1.Width * 0.18

ActiveCell = MyArray(n)

If ComboBox1 = "CLEAR" Then
    Range(ActiveCell.Address) = ""
End If

End Sub

Exempel 2: Alternativ ingår inte

Detta exempel används för att specificera alternativ som kanske inte inkluderas i en databas med tillgängliga bostäder och dess tillhörande bekvämligheter.

Det bygger på det föregående exemplet med några skillnader:

1. Två procedurer är inte längre nödvändiga för en enda kombinationsruta, genom att kombinera koden till en enda procedur.
2. Användningen av egenskapen LinkedCell för att möjliggöra korrekt inmatning av användarvalet varje gång
3. Inkluderingen av en säkerhetskopieringsfunktion för att säkerställa att den aktiva cellen finns i rätt kolumn och en felförebyggande kod, baserad på tidigare erfarenheter, där numeriska värden skulle formateras som strängar när de fylls i den aktiva cellen.

Private Sub cboNotIncl_Change()

Dim n As Long
Dim notincl_array(1 To 9) As String

n = myTarget.Row
            
    If n >= 3 And n < 10000 Then
             
        If myTarget.Address = "$G$" & n Then
                
            'set up the array elements for the not included services
            notincl_array(1) = "Central Air"
            notincl_array(2) = "Hot Water"
            notincl_array(3) = "Heater Rental"
            notincl_array(4) = "Utilities"
            notincl_array(5) = "Parking"
            notincl_array(6) = "Internet"
            notincl_array(7) = "Hydro"
            notincl_array(8) = "Hydro/Hot Water/Heater Rental"
            notincl_array(9) = "Hydro and Utilities"
            
            cboNotIncl.List = notincl_array()
                    
        Else
                
            Exit Sub
                
        End If

        With cboNotIncl
                    
            'make sure the combo box moves to the target cell
            .Left = myTarget.Left
            .Top = myTarget.Top
                    
            'adjust the size of the cell to fit the combo box
            myTarget.ColumnWidth = .Width * 0.18
                    
            'make it look nice by editing some of the font attributes
            .Font.Size = 11
            .Font.Bold = False
                        
            'populate the cell with the user choice, with a backup guarantee that it's in column G
                
            If myTarget.Address = "$G$" & n Then
                    
                    .LinkedCell = myTarget.Address
                    
                    'prevent an error where a numerical value is formatted as text
                    myTarget.EntireColumn.TextToColumns
                    
            End If
                
        End With
                
    End If 'ensure that the active cell is only between rows 3 and 1000
            
End Sub

Ovanstående makro initieras varje gång en cell aktiveras med SelectionChange-händelsen i kalkylmodulen:

Public myTarget As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Set myTarget = Target

    'switch for Not Included
    If Target.Column = 7 And Target.Cells.Count = 1 Then

        Application.Run "Module1.cboNotIncl_Change"

    End If

End Sub