Board logo

標題: 使用 資料>驗證>儲存格的下拉式清單，可以讓下拉顯示窗格增加列數嗎? [打印本頁]
作者: sasser    時間: 2010-12-11 15:05     標題: 使用 資料>驗證>儲存格的下拉式清單，可以讓下拉顯示窗格增加列數嗎?

請問使用 資料>驗證>儲存格的下拉式清單，下拉顯示窗格只有8列，超出即須使用捲軸，可以讓下拉顯示窗格增加列數嗎?
[attach]4040[/attach]
作者: HUNGCHILIN    時間: 2010-12-11 15:58

本帖最後由 Hsieh 於 2010-12-12 23:49 編輯

回復 1# sasser
基本上這一帖 以前在EXCELHELP 上有人發表過
但目前EXCELHELP以已關版

我將文章貼在這HUNGCHILIN
檔案連結也沒有了無法下載

使用下列程式 COPY 後 貼到這個檔案中的 THISWORKBOOK 程式區內就可以使用了
----------------------------------------------------------------------------------------
加長 驗證 的長度及寬度　

這篇關於驗證的文章 對於驗證有很大的幫助
可以突破excel限制使驗證清單拉長會比較方便

轉貼給各位參考
  1. Option Explicit

  3. Dim oDpd As Object
  4. Dim sFml1
  5. Dim prvTarget As Range

  7. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  8.    Const dFixedPos As Double = "0.8"
  9.    Const dFixWidth As Double = "16"    ' 改變 DropDown 的寬度
  10.    Dim vld As Validation
  11.    Dim lDpdLine As Long

  13.    If Not prvTarget Is Nothing Then
  14.        If Not oDpd Is Nothing Then
  15.            If oDpd.value = 0 Then
  16.                prvTarget.value = vbNullString
  17.            Else
  18.                prvTarget.value = Range(Mid(sFml1, 2)).Item(oDpd.value)
  19.            End If
  20.            Set prvTarget = Nothing
  21.        End If
  22.    End If

  24.    On Error Resume Next
  25.    oDpd.Delete
  26.    sFml1 = vbNullString
  27.    Set oDpd = Nothing
  28.    On Error GoTo 0

  30.    If Target.Count > 1 Then
  31.        Set oDpd = Nothing
  32.        Exit Sub
  33.    End If

  35.    Set vld = Target.Validation
  36.    On Error GoTo Terminate
  37.    sFml1 = vld.formula1
  38.    On Error GoTo 0

  40.    Set prvTarget = Target

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

  44.    With Target
  45.        Set oDpd = ActiveSheet.DropDowns.Add( _
  46.                                             .Left - dFixedPos, _
  47.                                             .Top - dFixedPos, _
  48.                                             .Width + dFixWidth + dFixedPos * 2, _
  49.                                             .Height + dFixedPos * 2)
  50.    End With
  51.    With oDpd
  52.        .ListFillRange = sFml1
  53.        .DropDownLines = lDpdLine
  54.        .Display3DShading = True
  55.    End With
  56. Terminate:
  57. End Sub
複製代碼
轉帖自 excelhelp
作者: HUNGCHILIN    時間: 2010-12-11 15:59

這個要用VBA才辦的到 此帖要轉到VBA版
作者: sasser    時間: 2010-12-12 10:52

回復 3# HUNGCHILIN


    感謝版主指導, 測試ok, 解決了我的困擾, 不過內容尚未完全參透, 需要再花點時間研究
作者: sasser    時間: 2010-12-12 11:31

回復 2# HUNGCHILIN


    發現一個狀況, 當同一儲存格已輸入完成, 若再選取該儲存格時, 則原先內容會被清空, 請問有解嗎?
[attach]4068[/attach]
作者: FAlonso    時間: 2010-12-12 21:09

本帖最後由 FAlonso 於 2010-12-14 12:25 編輯
  1. If Not prvTarget Is Nothing Then
  2.        If Not oDpd Is Nothing Then
  3.            If oDpd.value = 0 Then
  4.                prvTarget.value = vbNullString
  5.            Else
  6.                prvTarget.value = Range(Mid(sFml1, 2)).Item(oDpd.value)
  7.            End If
  8.            Set prvTarget = Nothing
  9.        End If
  10.    End If

  12.    On Error Resume Next
  13.    oDpd.Delete
  14.    sFml1 = vbNullString
  15.    Set oDpd = Nothing
  16.    On Error GoTo 0
複製代碼
這段程式怎麼解,想了很久都沒頭緒
還有這個VBA似乎有一個後遺症,就是當click有下拉式清單格子時,它會自動增加一個下拉式清單(及其編號也節節上升),搞得該格子滿是清單,混亂至極
有沒有辦法把清單的.listfullrange及.dropdownlines設定replace掉就算了?



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)