對話框

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
          請知道的前輩,不吝賜教謝謝再三!!

myleoyes

回復 13# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!!辛苦囉!!

GBKEE

回復 11# myleoyes
F(Rows.Count, 1).End(xlUp)(2, 1) = Date   '  給物件值
F(Rows.Count, 1).End(xlUp)(2, 1).Select     '  物件的方法

myleoyes

回復 11# myleoyes
luhpro前輩你好!
　　　　 前輩!謝謝!真的可以耶!!
         歹勢!!大眼睛一直在忙沒有注意到
         你的傑作謝謝再三!!

myleoyes

回復 10# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!程式需求
         Sub 連續()
            Dim F As Range
              With Sheet1
              .Select
              Set F = .Rows(1).Find(Month(Date) & "月", LookIn:=xlValues)
              F(Rows.Count, 1).End(xlUp)(2, 1) = Date
            End With
        End Sub
        但程式並沒有將滑鼠順便帶上日期的位置
        因為滑鼠的位置是執行下個程式的按鈕
        再附檔參考看看請再辛苦囉!!謝謝再三!!

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

複製代碼

luhpro

只要改那行就可以了 :

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

改成

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

myleoyes

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

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

回復 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
          謝謝再三!!