- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2020-4-25 14:44
| 只看該作者
本帖最後由 GBKEE 於 2020-4-25 14:47 編輯
回復 1# 劉大胃
365 中 [註解] CommentThreaded 或 [附註] Comment 儲存格只可二選一
365 新版的[註解] 可加入多筆的註解,2003,2010 的註解 Comment 365中改為[附註]'
註解所在工作表模組的程式碼- Option Explicit
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- With Target
- If Not .Comment Is Nothing Then '處理356 的[附註]也是2003,2010的[註解]
- Note_Text .Address(0, 0, , 1), .NoteText
- End If
- End With
- End Sub
- Private Sub Note_Text(Rng As String, Rng_Text As String)
- Dim xMatch As Variant, xN As Integer, i As Integer
- On Error GoTo ERR
- With Sheets("Note_Text")
- xMatch = Application.Match(Rng, .Rows(1), 0)
- If IsError(xMatch) Then
- With .Cells(1, Application.CountA(.Rows(1)) + 1)
- .Cells(1) = Rng
- .Cells(2) = Rng_Text & "--" & Now()
- End With
- Else
- xN = Application.CountA(.Columns(xMatch))
- With .Cells(1, xMatch)
- If Split(.Cells(xN), "--")(0) <> Rng_Text Then .Cells(xN + 1) = Rng_Text & "--" & Now()
- Rng_Text = ""
- For i = 2 To xN + 1
- Rng_Text = Rng_Text & IIf(i > 2, vbLf, "") & .Cells(i)
- Next
- MsgBox Rng_Text
- End With
- End If
- End With
- Exit Sub
- ERR:
- With ThisWorkbook
- With .Sheets.Add(, .Sheets(.Sheets.Count))
- .Name = "Note_Text"
- ' .Visible = xlSheetVeryHidden '隱藏起來能用巨集取消
- End With
- .Save
- Me.Activate
- End With
- Resume
- End Sub
複製代碼 |
|