返回列表 上一主題 發帖

如何改寫

如何改寫

  1. Public ckCurr As Boolean

  2. Private Sub XXXXComboBox1_Change()    '  stillfish00 提供
  3.     If ckCurr Then Exit Sub
  4.    
  5.     Application.EnableEvents = False
  6.    
  7.     ckCurr = False
  8.     ComboBox1.Visible = False
  9.     Range(ComboBox1.LinkedCell).Offset(, 2).Select
  10.     Application.EnableEvents = True
  11. End Sub

  12. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  13.     Dim StrVdFml As String
  14.    
  15.     '  If ckCurr Then Exit Sub
  16.     On Error Resume Next
  17.         StrVdFml = Replace(ActiveCell.Validation.Formula1, "=", "")
  18.         '  ActiveCell.Validation.Formula1 :  "=工作表1!$A$3:$A$20"
  19.         '  ComboBox1.ListFillRange        :   工作表1!$A$3:$A$20
  20.         '  Replace(ActiveCell.Validation.Formula1, "=", "") : "工作表1!$A$3:$A$20"
  21.         '  StrVdFml : "工作表1!$A$3:$A$20"
  22.         ActiveCell.Validation.InCellDropdown = False
  23.     On Error GoTo 0
  24.     If StrVdFml = "" Then
  25.         If Me.ComboBox1.Visible Then Me.ComboBox1.Visible = False
  26.     Else
  27.         With Me.ComboBox1
  28.             '  ComboBox1.progID   =EMBED("Forms.ComboBox.1","")
  29.             '  ComboBox1:        ComboBox
  30.             '  LinkedCell:       $A$2
  31.             '  ListFillRange :   工作表1!$A$3:$A$20
  32.             .Left = ActiveCell.Left
  33.             .Top = ActiveCell.Top
  34.             '  .Width = ActiveCell.Width + 140
  35.             .Width = ActiveCell.Width + 80
  36.             '  .Height = ActiveCell.Height + 10
  37.             .Height = ActiveCell.Height + 5
  38.             '  .Font.Size = 22
  39.             .Font.Size = 16

  40.             .LinkedCell = ActiveCell.Address    '  "$A$2"
  41.             .ListFillRange = StrVdFml           '  "工作表1!$A$3:$A$20"
  42.             .Visible = 1                        '  顯示下拉符號

  43.             .Object.SpecialEffect = 3
  44.             '.Object.Font.Size = ActiveCell.Font.Size
  45.         End With
  46.     End If
  47.   
  48.     ckCurr = False
  49. End Sub

  50. Sub CellValidation()      '  stillfish00 提供
  51.     With Sheets("工作表1").[B2:B200].Validation
  52.         .Delete
  53.         .Add Type:=xlValidateList, Formula1:="=工作表2!$C$2:$C$200"
  54.     End With
  55. End Sub
複製代碼
原功能:
點工作表1的B2時,會顯示工作表2的B2:B200的資料

改成:
點工作表1的C2時,會顯示工作表2的C2:C200的資料

所以我將B2:B200這段改成C2:C200~更改失敗~無資料

        靜思自在 : 一句溫暖的話,就像往別人身上灑香水,自己會沾到兩三滴。
返回列表 上一主題