返回列表 上一主題 發帖

對話框

回復 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. Sub 註解()
  20.         If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
  21.         ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
  22.         If ZZ = "" Then ActiveCell.Comment.Delete: Exit Sub
  23.         ActiveCell.Comment.Text Text:=ZZ
  24. End Sub
複製代碼

TOP

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

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

TOP

回復 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
複製代碼

TOP

回復 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
複製代碼

TOP

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

TOP

        靜思自在 : 自己害自己,莫過於亂發脾氣。
返回列表 上一主題