Excel使用xlValidateList的验证规则显示的下拉列表太窄。

huangapple go评论81阅读模式
英文:

Excel Validation rule using xlValidateList presents a dropdown list that is too narrow

问题

使用以下的VBA代码向电子表格中的单元格添加验证:

Public Sub AddTransactionTypeValidationToCell(Target As Range)
    Dim list As String
    
    list = "Expense Debit \ (Credit)," & _
            "Income Debit \ (Credit)," & _
            "Transfer Out Debit \ (Credit)," & _
            "Transfer In Debit \ (Credit)," & _
            "Beneficiary Distribution Debit \ (Credit)"
    
    
    Target.Validation.Delete
    Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=list
End Sub

我得到了一个太窄的验证列表:

Excel使用xlValidateList的验证规则显示的下拉列表太窄。

有没有办法使这个下拉列表变得更宽,而不必扩大包含验证规则的单元格所在的列?

英文:

Using the following VBA code to add validation to a cell in a spreadsheet:

Public Sub AddTransactionTypeValidationToCell(Target As Range)
    Dim list As String
    
    list = "Expense Debit \ (Credit)," & _
            "Income Debit \ (Credit)," & _
            "Transfer Out Debit \ (Credit)," & _
            "Transfer In Debit \ (Credit)," & _
            "Beneficiary Distribution Debit \ (Credit)"
    
    
    Target.Validation.Delete
    Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=list
End Sub

I get a validation list that is too narrow:

Excel使用xlValidateList的验证规则显示的下拉列表太窄。

Is there a way to make this dropdown list wider without widening the column holding the cell that contains the validation rule?

答案1

得分: 1

以下是翻译好的代码部分:

Public Sub setVListWidth(r As Range, ws As Worksheet)
   Dim s As String, p As Integer, p1 As Integer, ir As Range, shp As Shape
   On Error GoTo Err
   If r.Validation.Type = xlValidateList Then
      s = r.Validation.Formula1
      Set ir = ws.Range(Mid(s, 2))
      Set shp = get_drop_shape(ws)
      If Not shp Is Nothing Then
         '在这里调整宽度以适应您的需求
         shp.Width = ir.Width * 75 / 100
         shp.Left = shp.Left + (r.Width - shp.Width) + 12.75
      End If
   End If
Err:
   On Error GoTo 0
End Sub

Public Function get_drop_shape(ws As Worksheet) As Shape
   Dim shp As Shape
   For Each shp In ws.Shapes
      If Left(shp.Name, 9) = "Drop Down" Then
         Set get_drop_shape = shp
         Exit Function
      End If
   Next
   Set get_drop_shape = Nothing
End Function


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.CountLarge = 1 Then
      If Target.Address = Range("G2").Address Then
         Call setVListWidth(Target, Me)
      End If
   End If
End Sub

请注意,我没有翻译代码中的注释部分,因为它们是英文注释,不需要翻译。如果您需要进一步的帮助或有其他问题,请随时告诉我。

英文:
Public Sub setVListWidth(r As Range, ws As Worksheet)
   Dim s As String, p As Integer, p1 As Integer, ir As Range, shp As Shape
   On Error GoTo Err
   If r.Validation.Type = xlValidateList Then
      s = r.Validation.Formula1
      Set ir = ws.Range(Mid(s, 2))
      Set shp = get_drop_shape(ws)
      If Not shp Is Nothing Then
         'here adjust the width to fit your needs
         shp.Width = ir.Width * 75 / 100
         shp.Left = shp.Left + (r.Width - shp.Width) + 12.75
      End If
   End If
Err:
   On Error GoTo 0
End Sub

Public Function get_drop_shape(ws As Worksheet) As Shape
   Dim shp As Shape
   For Each shp In ws.Shapes
      If Left(shp.Name, 9) = "Drop Down" Then
         Set get_drop_shape = shp
         Exit Function
      End If
   Next
   Set get_drop_shape = Nothing
End Function


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.CountLarge = 1 Then
      If Target.Address = Range("G2").Address Then
         Call setVListWidth(Target, Me)
      End If
   End If
End Sub

Excel使用xlValidateList的验证规则显示的下拉列表太窄。

huangapple
  • 本文由 发表于 2023年6月16日 03:46:26
  • 转载请务必保留本文链接:https://go.coder-hub.com/76485072.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定