英文:
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
我得到了一个太窄的验证列表:
有没有办法使这个下拉列表变得更宽,而不必扩大包含验证规则的单元格所在的列?
英文:
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:
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
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论