excel如何设定数据有效性下拉列表框的长度和宽度

wulai8377

excel如何设定数据有效性下拉列表框的长度和宽度
有知道的没

先拉宽,设置好数据有效性后再拉窄的不行,一保存恢复原样.

梅州

好像这个没得调的~~~

wulai8377

找到一个可以调整宽度的
http://club.excelhome.net/forum.php?mod=viewthread&tid=339981
[分享]用VBA改变数据有效性序列选择列表的宽度

来自:  http://www.excelfans.cn/blog/article.asp?id=122 代码: Private Sub Worksheet_SelectionChange(ByVal Target As Range)     Const ValidWidth = 2       '宽度倍数     If Target.Validation.Value = True Then MakeValidationWidthWide Target, ValidWidth End Sub 在模块中: Sub MakeValidationWidthWide(ByVal Target As Range, RelativeToOriginalSize)     Dim wks As Worksheet     Dim elmDic As Object     Dim elmShp As Shape     Dim drpShp As Shape     Dim objDic As Object     Set wks = Target.Parent     On Error GoTo Terminate     wks.AutoFilterMode = False     If Target.Cells.Count > 1 Then Exit Sub     If Target.Validation.Type = xlValidateList Then         Set objDic = CreateObject("Scripting.Dictionary")         For Each elmDic In wks.DrawingObjects             objDic.Add elmDic.Name, elmDic.Name         Next         For Each elmShp In wks.Shapes             If elmShp.Name Like "Drop Down *" Then                 If Not objDic.Exists(elmShp.Name) Then                     Set drpShp = elmShp                     Exit For                 End If             End If         Next         If Not drpShp Is Nothing Then             drpShp.ScaleWidth RelativeToOriginalSize, False, msoScaleFromBottomRight             SendKeys "%{down}"         End If     End If Terminate:     Set drpShp = Nothing     Set objDic = Nothing End Sub 不过有点小问题：对这个工作表里所有的数据有效性的宽度都改了。如何用简单的代码来“限制”它的“作用范围”呢？ [此贴子已经被作者于2008-7-22 11:56:00编辑过]

wulai8377

有找到一个可以调整有效性下拉列表高度的

http://club.excelhome.net/thread-72227-2-1.html
第13楼

有效性下拉框的高度 显示更多更直观
Option Explicit

Dim oDpd As Object
Dim sFml1
Dim prvTarget As Range

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Const dFixedPos As Double = "0.8"
    Const dFixWidth As Double = "16"    'Change here to change WIDTH of the DropDown
    Dim vld As Validation
    Dim lDpdLine As Long

    If Not prvTarget Is Nothing Then
        If Not oDpd Is Nothing Then
            If oDpd.Value = 0 Then
                prvTarget.Value = vbNullString
            Else
                prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
            End If
            Set prvTarget = Nothing
        End If
    End If

    On Error Resume Next
    oDpd.Delete
    sFml1 = vbNullString
    Set oDpd = Nothing
    On Error GoTo 0

    If Target.Count > 1 Then
        Set oDpd = Nothing
        Exit Sub
    End If

    Set vld = Target.Validation
    On Error GoTo Terminate
    sFml1 = vld.Formula1
    On Error GoTo 0

    Set prvTarget = Target

    lDpdLine = Range(Mid(sFml1, 2)).Rows.Count

    With Target
        Set oDpd = ActiveSheet.DropDowns.Add( _
                                             .Left - dFixedPos, _
                                             .Top - dFixedPos, _
                                             .Width + dFixWidth + dFixedPos * 2, _
                                             .Height + dFixedPos * 2)
    End With
    With oDpd
        .ListFillRange = sFml1
        .DropDownLines = lDpdLine
        .Display3DShading = True
    End With
Terminate:
End Sub

wulai8377

有大神能把上面调整有效性下拉框宽度和高度的综合到一起么,技能调整宽度,也能调整高度的!???

wulai8377

或者能把上面的代码给讲解注释一下，大神>o<！

huangyanqiang

wulai8377 发表于 2021-5-20 14:13
有大神能把上面调整有效性下拉框宽度和高度的综合到一起么,技能调整宽度,也能调整高度的!???

我也有同样的述求，你有找到方法吗？

wulai8377

huangyanqiang 发表于 2024-3-18 16:57
我也有同样的述求，你有找到方法吗？

没有啊,最后只能放弃了!