Sub 檢查_含有註解格數量_New()
Dim hascomN&, msg1$, msg2$, L&, T&, hascomERRN&
Dim uR As Range, com As Comment
msg1 = "1.有註解儲存格格位: "
For Each com In ActiveSheet.Comments '此活工作表 註解'集合'
With com '針對所有註解
hascomN = hascomN + 1 '計算
msg1 = msg1 & .Parent.Address '對應的儲存格位置
Set uR = Range(.Parent.Address) '指定該儲存格物件
L = .Shape.Left - (uR.Left + uR.Width + 200) '你原本的規則
T = .Shape.Top - (uR.Top + 50) '你原本的規則
If L > 0 Or T > 0 Then hascomERRN = hascomERRN + 1 '累加不合規則的註解數
End With
Next
If hascomN > 20 Then msg1 = "1.含有註解格太多!不顯示格位" '你原本的規則
msg2 = "2.註解實際位置跑掉的格:" & hascomERRN & " 個"
If hascomERRN = 0 Then msg2 = "2.沒有註解實際位置跑掉的格" '你原本的規則
MsgBox msg1 & Chr(10) & msg2
End Sub
Sub 註解_調整至指定位置_New()
Dim com As Comment, SetLeft&, SetTop&
Const L = 20: Const T = 20 '你原本的規則
For Each com In ActiveSheet.Comments '此活工作表 註解'集合'
With com '針對所有註解
With Range(.Parent.Address) '指定該儲存格物件
SetLeft = .Left + .Width + L '你原本的規則
SetTop = .Top + T '你原本的規則
End With
With .Shape: .Left = SetLeft: .Top = SetTop: End With '設定註解位置
End With
Next
Application.DisplayCommentIndicator = 1 '顯示註解和指標
End Sub
發表於 2020-8-10 22:17
| 
