麻辣家族討論版版 - Powered by Discuz! Board

標題: 對話框 [打印本頁]

作者: myleoyes 時間: 2010-7-22 08:12 標題: 對話框

各位前輩你們好!
　　    前輩!問題如附檔案說明
      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 時間: 2010-7-22 14:04

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

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

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

複製代碼

直接運

項目

複製代碼

然後把項目改成以下的

Sub 項目()
Dim Z As string
If ActiveCell <> "" Then
z = ActiveCell
Else
z = "早安！"
End If
Z = ActiveCell.value
Z = Application.InputBox("請輸入項目名稱", , z, Type:=2)
ActiveCell.value = z
ActiveCell.Offset(, 1).Select
End Sub

複製代碼

問題二: (小弟午飯時間快過

, 暫提供代碼, 有需要的話今晚再解釋解釋)

Sub 註解()
If Not ActiveCell.Comment Is Nothing Then
ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
Else
ZZ = InputBox("請輸入附註", , "")
ActiveCell.AddComment
End If
ActiveCell.Comment.Text Text:=ZZ
End Sub

複製代碼

作者: GBKEE 時間: 2010-7-22 16:21

回復 1# myleoyes

Sub 項目()
Dim Z, Msg As Boolean
Z = Application.InputBox("請輸入項目名稱", , "早安！", Type:=2)
If Z <> False Then
Msg = False
For I = 1 To Len(Z)
If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: Exit For '判定是字串
Next
If Msg Then
ActiveCell = Z
Else
ActiveCell = ""
End If
ElseIf Z = False Then
ActiveCell = ""
End If
ActiveCell.Offset(, 1).Select
End Sub
Sub 註解()
If ActiveCell.Comment Is Nothing Then ActiveCell.AddComment
ZZ = InputBox("請輸入附註", , ActiveCell.Comment.Text)
If ZZ = "" Then ActiveCell.Comment.Delete: Exit Sub
ActiveCell.Comment.Text Text:=ZZ
End Sub

複製代碼

作者: myleoyes 時間: 2010-7-22 22:11

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

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

作者: GBKEE 時間: 2010-7-23 15:27

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

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

作者: myleoyes 時間: 2010-7-24 11:32

回復 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 時間: 2010-7-24 14:58

回復 6# myleoyes

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target(1)
If .Row >= 3 And .Row <= 200 And .Column >= 2 And .Column <= 100 Then
If .Column Mod 3 = 0 And .Value = "" Then 項目 'C欄
If (.Column - 1) Mod 3 = 0 Then 'D欄
If .Value = "" Then 數據 Else 註解
End If
End If
End With
End SubSub 項目()
Dim Z, Tile$, Msg As Boolean 'Msg 預設是 False
Tile = "請輸入項目名稱"
Again:
Z = Application.InputBox(Tile, , "早安！", Type:=2)
If Z <> False Then
For I = 1 To Len(Z)
If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: Exit For
Next
If Msg = True Then 'Msg = True 是字串
ActiveCell = Z
Else '判定非字串
Tile = "請輸入項目名稱 -- 必須是文字 "
GoTo Again
End If
ElseIf Z = False Then '按下取消
ActiveCell = ""
End If
ActiveCell.Offset(, 1).Select
End Sub

複製代碼

作者: myleoyes 時間: 2010-7-26 22:07

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

作者: luhpro 時間: 2010-7-26 22:39

只要改那行就可以了 :

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

改成

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

作者: GBKEE 時間: 2010-7-27 13:33

回復 8# myleoyes

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

複製代碼

作者: myleoyes 時間: 2010-7-27 22:46

回復 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
      但程式並沒有將滑鼠順便帶上日期的位置
      因為滑鼠的位置是執行下個程式的按鈕
      再附檔參考看看請再辛苦囉!!謝謝再三!!

作者: myleoyes 時間: 2010-7-27 23:21

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

作者: GBKEE 時間: 2010-7-28 16:36

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

作者: myleoyes 時間: 2010-7-29 20:55

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

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