12
返回列表 上一主題 發帖

對話框

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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
          請知道的前輩,不吝賜教謝謝再三!!

Leov16.rar (15.11 KB)

收藏 分享

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
2#
發表於 2010-7-22 14:04 | 只看該作者
各位前輩你們好!
　　      前輩!問題如附檔案說明
          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
複製代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2010-7-22 16:21 | 只看該作者
回復 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

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

TOP

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
4#
發表於 2010-7-22 22:11 | 只看該作者
回復 3# GBKEE
kimbal前輩你好!
       前輩!謝謝!項目程式你可能誤解,
       這裡是約束對話框只接受文字輸入!
       而註解是在於不留白
       因為空白註解是無異議的
       如良師的程式就是小弟的需求
       謝謝再三!!!

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2010-7-23 15:27 | 只看該作者
有出入,當對話框輸入數字時
         應該是Again 而非Exit
         按取消才是離開myleoyes 發表於 2010-7-22 22:11

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

TOP

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
6#
發表於 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
          謝謝再三!!

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2010-7-24 14:58 | 只看該作者
回復 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

myleoyes

帖子
463 
主題
116 
精華
0 
積分
580 
點名
0  
作業系統
Vista 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2010-5-4 
最後登錄
2017-11-13 

論壇贊助勳章論壇榮譽勳章
8#
發表於 2010-7-26 22:07 | 只看該作者
回復 7# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!辛苦你囉!
         歹勢!!請再辛苦一下這個檔案
         程式為何?請不吝賜教謝謝再三!!

Leov17.rar (14.44 KB)

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
9#
發表於 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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2010-7-27 13:33 | 只看該作者
回復 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

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
12
返回列表 上一主題