ML089

回復 10# c_c_lai

謝謝你提供那麼詳細的說明

我的EXCEL開啟(安全同意也開啟)也依照畫面步驟去點選A2，可是沒有出現下拉表，是否我缺少什麼物件

下載 (49.79 KB)

2013-11-6 10:36

ML089

回復 10# c_c_lai

我的EXCEL是2007
開啟你的檔案，其工作表名稱是 Sheet1、 Sheet2、 Sheet3
但VBA程式中用的工作表名稱是 工作表1、工作表2
我試著將 VBA中的 "工作表" 改為 "Sheet" 也不行
該如何是好  

例如
Sub CellValidation()      '  stillfish00 提供
    With Sheets("工作表2").[A2:A25].Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:="=工作表1!$A$3:$A$20"
    End With
End Sub

c_c_lai

回復  c_c_lai

我的EXCEL是2007
開啟你的檔案，其工作表名稱是 Sheet1、 Sheet2、 Sheet3
但VBA程式中 ...
ML089 發表於 2013-11-6 10:49

之前我是另外新增一Excel檔案測試，完成後便直接將程式碼貼入到原本的
"相片輸出價目表.xlsm" 內，忘了將其對應的表單名稱一併修正，真是對不起！
相片輸出價目表.rar (24.83 KB)

下載次數: 8

2013-11-6 11:51

c_c_lai

回復 12# ML089
你再試試看，測試結果如何再行告訴我。
謝謝！

ML089

回復 14# c_c_lai

還是不行，按A2、A3...都沒有反應
之前樓主的檔案也不行，後來我自行設定 資料驗證(清單) ，下拉選單才出現

請問 ComboBox1 是否需要自行增設，還是程式已經內定就有

c_c_lai

回復  c_c_lai

還是不行，按A2、A3...都沒有反應
之前樓主的檔案也不行，後來我自行設定 資料驗證(清單 ...
ML089 發表於 2013-11-6 12:47

請問你是下載 "相片輸出價目表.xlsm" 直接用它來測試，還是
自己另外開啟一新檔案，而僅複製程式碼來運作？

owen06

回復 16# c_c_lai


我也是耶，直接開啟下載的檔案，然後點了A2就出現錯誤訊息了，
二個檔案都一樣。

c_c_lai

回復 17# owen06
請你直接開啟 #1 的附件，然後將以下程式碼貼入到 Sheet2 的程式碼區再試試看  (完全複製過去)，
結果如何請回復告知，謝謝！ (我這邊無論是另行新增、或者是使用 #1 的附件都是OK的 )

1. Public ckCurr As Boolean
   
2. 
   
3. Private Sub ComboBox1_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 CommandButton1_Click()
    
15.     If Me.ComboBox1.Visible Then ckCurr = True: Me.ComboBox1.Visible = False
    
16.    
    
17.     Range("A2:A25,C2:C25").Select
    
18.     Selection.ClearContents
    
19. End Sub
    
20. 
    
21. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
22.     Dim StrVdFml As String
    
23.    
    
24.     '  If ckCurr Then Exit Sub
    
25.     On Error Resume Next
    
26.         StrVdFml = Replace(ActiveCell.Validation.Formula1, "=", "")
    
27.         '  ActiveCell.Validation.Formula1 ：  "=Sheet1!$A$3:$A$20"
    
28.         '  ComboBox1.ListFillRange        ：   Sheet1!$A$3:$A$20
    
29.         '  Replace(ActiveCell.Validation.Formula1, "=", "") : "Sheet1!$A$3:$A$20"
    
30.         '  StrVdFml : "Sheet1!$A$3:$A$20"
    
31.         ActiveCell.Validation.InCellDropdown = False
    
32.     On Error GoTo 0
    
33.     If StrVdFml = "" Then
    
34.         If Me.ComboBox1.Visible Then Me.ComboBox1.Visible = False
    
35.     Else
    
36.         With Me.ComboBox1
    
37.             '  ComboBox1.progID   =EMBED("Forms.ComboBox.1","")
    
38.             '  ComboBox1：        ComboBox
    
39.             '  LinkedCell：       $A$2
    
40.             '  ListFillRange ：   Sheet1!$A$3:$A$20
    
41.             .Left = ActiveCell.Left
    
42.             .Top = ActiveCell.Top
    
43.             '  .Width = ActiveCell.Width + 140
    
44.             .Width = ActiveCell.Width
    
45.             '  .Height = ActiveCell.Height + 10
    
46.             .Height = ActiveCell.Height
    
47.             '  .Font.Size = 22
    
48.             .Font.Size = 12
    
49. 
    
50.             .LinkedCell = ActiveCell.Address    '  "$A$2"
    
51.             .ListFillRange = StrVdFml           '  "Sheet1!$A$3:$A$20"
    
52.             .Visible = 1                        '  顯示下拉符號
    
53. 
    
54.             .Object.SpecialEffect = 3
    
55.             '.Object.Font.Size = ActiveCell.Font.Size
    
56.         End With
    
57.     End If
    
58.   
    
59.     ckCurr = False
    
60. End Sub
    
61. 
    
62. Private Sub Worksheet_Change(ByVal Target As Range)
    
63.     '  Target.Font.ColorIndex = 5
    
64.    
    
65.     If Not Intersect(Target, Range("C2:C25")) Is Nothing Then
    
66.         If Target(1, 1) = 0 Then Exit Sub
    
67.         ckCurr = True
    
68.         '  MsgBox Target.Address
    
69.         Target.Offset(1, -2).Select
    
70.     End If
    
71. End Sub
    
72. 
    
73. Sub CellValidation()      '  stillfish00 提供
    
74.     With Sheets("Sheet2").[A2:A25].Validation
    
75.         .Delete
    
76.         .Add Type:=xlValidateList, Formula1:="=Sheet1!$A$3:$A$20"
    
77.     End With
    
78. End Sub

複製代碼

ML089

回復 18# c_c_lai


開啟 #1 的附件，然後將程式碼貼入到 Sheet2 的程式碼區，還是不行

自行設定 資料驗證 後，是可以執行，下拉選單 - 選完自動跳到 C欄數量 - 輸入數量也自動跳到下一列。
可是下拉選單又好像不是 資料驗證的下拉選單，應該是ComboBox1得下拉選單

我自己用資料驗證配合Worksheet_Change也可以達到效果，只是資料驗證選單功能比較陽春。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Target.Offset(, 2).Select
    ElseIf Target.Column = 3 Then
        Target.Offset(1, -2).Select
    End If
End Sub

相片輸出價目表_ML089.rar (31.27 KB)

下載次數: 4

2013-11-6 15:07

c_c_lai

回復 19# ML089
再試試看 (有整理過)

下載 (76.34 KB)

2013-11-6 15:48

相片輸出價目表_ML089.rar (24.95 KB)

下載次數: 6

2013-11-6 15:49