標題: 如何改寫 [打印本頁]

---

作者: av8d    時間: 2014-2-27 11:12     標題: 如何改寫

1. Public ckCurr As Boolean
   
2. 
   
3. Private Sub XXXXComboBox1_Change()    '  stillfish00 提供
   
4.     If ckCurr Then Exit Sub
   
5.    
   
6.     Application.EnableEvents = False
   
7.    
   
8.     ckCurr = False
   
9.     ComboBox1.Visible = False
   
10.     Range(ComboBox1.LinkedCell).Offset(, 2).Select
    
11.     Application.EnableEvents = True
    
12. End Sub
    
13. 
    
14. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
15.     Dim StrVdFml As String
    
16.    
    
17.     '  If ckCurr Then Exit Sub
    
18.     On Error Resume Next
    
19.         StrVdFml = Replace(ActiveCell.Validation.Formula1, "=", "")
    
20.         '  ActiveCell.Validation.Formula1 ：  "=工作表1!$A$3:$A$20"
    
21.         '  ComboBox1.ListFillRange        ：   工作表1!$A$3:$A$20
    
22.         '  Replace(ActiveCell.Validation.Formula1, "=", "") : "工作表1!$A$3:$A$20"
    
23.         '  StrVdFml : "工作表1!$A$3:$A$20"
    
24.         ActiveCell.Validation.InCellDropdown = False
    
25.     On Error GoTo 0
    
26.     If StrVdFml = "" Then
    
27.         If Me.ComboBox1.Visible Then Me.ComboBox1.Visible = False
    
28.     Else
    
29.         With Me.ComboBox1
    
30.             '  ComboBox1.progID   =EMBED("Forms.ComboBox.1","")
    
31.             '  ComboBox1：        ComboBox
    
32.             '  LinkedCell：       $A$2
    
33.             '  ListFillRange ：   工作表1!$A$3:$A$20
    
34.             .Left = ActiveCell.Left
    
35.             .Top = ActiveCell.Top
    
36.             '  .Width = ActiveCell.Width + 140
    
37.             .Width = ActiveCell.Width + 80
    
38.             '  .Height = ActiveCell.Height + 10
    
39.             .Height = ActiveCell.Height + 5
    
40.             '  .Font.Size = 22
    
41.             .Font.Size = 16
    
42. 
    
43.             .LinkedCell = ActiveCell.Address    '  "$A$2"
    
44.             .ListFillRange = StrVdFml           '  "工作表1!$A$3:$A$20"
    
45.             .Visible = 1                        '  顯示下拉符號
    
46. 
    
47.             .Object.SpecialEffect = 3
    
48.             '.Object.Font.Size = ActiveCell.Font.Size
    
49.         End With
    
50.     End If
    
51.   
    
52.     ckCurr = False
    
53. End Sub
    
54. 
    
55. Sub CellValidation()      '  stillfish00 提供
    
56.     With Sheets("工作表1").[B2:B200].Validation
    
57.         .Delete
    
58.         .Add Type:=xlValidateList, Formula1:="=工作表2!$C$2:$C$200"
    
59.     End With
    
60. End Sub

複製代碼

原功能:
點工作表1的B2時，會顯示工作表2的B2:B200的資料

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

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

---

作者: GBKEE    時間: 2014-2-27 12:39

回復 1# av8d
2003版中 新增驗證公式 直接參照到本身之外的工作表,會有錯誤

1. Sub CellValidation()
   
2.    Sheets("SHEET2").Range("C2:C200").Name = "XX"
   
3.    With Sheets(1).[B2:B200].Validation    '可改成 [C2:C200]
   
4.             .Delete
   
5.             .Add Type:=xlValidateList, Formula1:="=XX"    '=SHEET2!$C$2:$C$200"
   
6.    End With
   
7. End Sub

複製代碼

---

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