對話框

myleoyes

各位前輩你們好!
　　      前輩!問題如附檔案說明
          Sub 註解()
             If Not ActiveCell.Comment Is Nothing Then
               ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
             End If
               On Error Resume Next
               ActiveCell.AddComment
               ActiveCell.Comment.Text Text:=ZZ
          End Sub
          請知道的前輩,不吝賜教謝謝再三!!

kimbal

各位前輩你們好!
　　      前輩!問題如附檔案說明
          Sub 註解()
             If Not ActiveCe ...
myleoyes 發表於 2010-7-22 08:12

    問題一:
你的意思是如果項目有東西, 就顯示原來的對吧?
首先在Worksheet_SelectionChange解除一下

1. If Target(1) = "" Then 項目
   
2. end if

複製代碼

直接運

1. 項目

複製代碼

然後把項目改成以下的

1. Sub 項目()
   
2.        Dim Z As string
   
3.        If ActiveCell <> "" Then
   
4.             z = ActiveCell
   
5.         Else
   
6.             z = "早安！"
   
7.         End If
   
8.        Z = ActiveCell.value
   
9.        Z = Application.InputBox("請輸入項目名稱", , z, Type:=2)
   
10.        ActiveCell.value = z
    
11.        ActiveCell.Offset(, 1).Select
    
12. End Sub

複製代碼

問題二: (小弟午飯時間快過 , 暫提供代碼, 有需要的話今晚再解釋解釋)

1. Sub 註解()
   
2.         If Not ActiveCell.Comment Is Nothing Then
   
3.             ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
   
4.         Else
   
5.             ZZ = InputBox("請輸入附註", , "")
   
6.             ActiveCell.AddComment
   
7.         End If
   
8.         ActiveCell.Comment.Text Text:=ZZ
   
9. End Sub

複製代碼

GBKEE

回復 1# myleoyes

1. Sub 項目()
   
2.        Dim Z, Msg As Boolean
   
3.        Z = Application.InputBox("請輸入項目名稱", , "早安！", Type:=2)
   
4.        If Z <> False Then
   
5.             Msg = False
   
6.             For I = 1 To Len(Z)
   
7.                 If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: Exit For '判定是字串
   
8.             Next
   
9.             If Msg Then
   
10.                 ActiveCell = Z
    
11.             Else
    
12.                 ActiveCell = ""
    
13.             End If
    
14.        ElseIf Z = False Then
    
15.             ActiveCell = ""
    
16.        End If
    
17.        ActiveCell.Offset(, 1).Select
    
18. End Sub
    
19. 
    
20. Sub 註解()
    
21.         If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
    
22.         ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
    
23.         If ZZ = "" Then ActiveCell.Comment.Delete: Exit Sub
    
24.         ActiveCell.Comment.Text Text:=ZZ
    
25. End Sub

複製代碼

myleoyes

回復 3# GBKEE
kimbal前輩你好!
       前輩!謝謝!項目程式你可能誤解,
       這裡是約束對話框只接受文字輸入!
       而註解是在於不留白
       因為空白註解是無異議的
       如良師的程式就是小弟的需求
       謝謝再三!!!

GBKEE前輩你好!
　　　　 良師!謝謝!項目程式與小弟的需求
         有出入,當對話框輸入數字時
         應該是Again 而非Exit
         按取消才是離開請再辛苦一下謝謝再三!!

GBKEE

有出入,當對話框輸入數字時
         應該是Again 而非Exit
         按取消才是離開myleoyes 發表於 2010-7-22 22:11

應該是Again 那就使用 Go To  Again
按取消 ->=False  你可以試著修改啊

myleoyes

回復 5# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!歹勢啦!之前有改過就是不行
         因為這個(按取消 ->=False)關鍵讓小弟終於想到
         Sub 項目()
          Dim Z, Msg As Boolean
          Again:
             Z = Application.InputBox("請輸入項目名稱", , "早安！", Type:=2)
                 For I = 1 To Len(Z)
                If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: '判定是字串
              Next
              If Z < False Then GoTo Again
              If Z >= False Then ActiveCell = Z
              If Z = False Then ActiveCell = ""
              ActiveCell.Offset(, 1).Select
          End Sub
          謝謝再三!!

GBKEE

回復 6# myleoyes

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     With Target(1)
   
3.         If .Row >= 3 And .Row <= 200 And .Column >= 2 And .Column <= 100 Then
   
4.            If .Column Mod 3 = 0 And .Value = "" Then 項目         'C欄
   
5.        If (.Column - 1) Mod 3 = 0 Then                        'D欄
   
6.           If .Value = "" Then 數據 Else 註解
   
7.        End If
   
8.         End If
   
9.     End With
   
10. End SubSub 項目()
    
11.     Dim Z, Tile$, Msg As Boolean 'Msg 預設是 False
    
12.     Tile = "請輸入項目名稱"
    
13. Again:
    
14.     Z = Application.InputBox(Tile, , "早安！", Type:=2)
    
15.     If Z <> False Then
    
16.         For I = 1 To Len(Z)
    
17.             If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: Exit For
    
18.         Next
    
19.         If Msg = True Then 'Msg = True 是字串
    
20.             ActiveCell = Z
    
21.         Else               '判定非字串
    
22.             Tile = "請輸入項目名稱 -- 必須是文字 "
    
23.             GoTo Again
    
24.         End If
    
25.     ElseIf Z = False Then  '按下取消
    
26.         ActiveCell = ""
    
27.     End If
    
28.     ActiveCell.Offset(, 1).Select
    
29. End Sub

複製代碼

myleoyes

回復 7# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!辛苦你囉!
         歹勢!!請再辛苦一下這個檔案
         程式為何?請不吝賜教謝謝再三!!

luhpro

只要改那行就可以了 :

.Range("AF" & Rows.Count).End(xlUp)(2, 1).Select

改成

.Cells(Rows.Count, 2 + (Month(Date) - 1) * 5).End(xlUp)(2, 1).Select

GBKEE

回復 8# myleoyes

1. Sub 連續()
   
2.      Dim F As Range
   
3.      With Sheet1
   
4.         .Select
   
5.         Set F = .Rows(1).Find(Month(Date) & "月", LookIn:=xlValues)
   
6.         If F(Rows.Count, 1).End(xlUp) <> Date Then F(Rows.Count, 1).End(xlUp)(2, 1) = Date
   
7.       End With
   
8.    ' 日期
   
9. End Sub
   
10. Sub 日期()
    
11.     If Month(Cells(1, Selection.Column)) = Month(Date) Then Selection = Date
    
12. End Sub

複製代碼