کد ویژوال بیسیک برای تغییر نام نویسنده کامنت در اکسل

Sub ChangeCommentName() 'downloaded from www.contextures.com 'replaces old names in comments 'deletes and reinserts comments, 'so new name appears in status bar Dim ws As Worksheet Dim cmt As Comment Dim cmt2 As Comment Dim strOld As String Dim strNew As String Dim strUser As String Dim strComment As String Dim strMsg As String Dim lBreak As Long Dim bUser As Boolean

On Error GoTo errHandler

strUser = Application.UserName

strOld = InputBox("Old Name", "Replace Comment Name", strUser) If Len(strOld) = 0 Then strMsg = "Cannot change comment names" _ & vbCrLf _ & "Old name must be at least one character" GoTo exitHandler End If

strNew = InputBox("New Name (at least one character)", "Replace Comment Name", strUser) If Len(strNew) = 0 Then strMsg = "Cannot change comment names" _ & vbCrLf _ & "New name must be at least one character" GoTo exitHandler End If

Application.UserName = strNew strMsg = "Could not change comments"

For Each ws In ActiveWorkbook.Worksheets For Each cmt In ws.Comments strComment = Replace(cmt.Text, strOld, strNew) cmt.Delete Set cmt2 = cmt.Parent.AddComment cmt2.Text Text:=strComment

lBreak = InStr(1, cmt2.Text, Chr(10)) If lBreak > 0 Then With cmt2.Shape.TextFrame .Characters.Font.bOld = False .Characters(1, lBreak - 1).Font.bOld = True End With End If Next cmt Next ws

bUser = MsgBox("Keep New Name as User Name?", vbYesNo + vbQuestion, "Excel User Name") If bUser <> vbYes Then Application.UserName = strUser End If strMsg = "Done!"

exitHandler: MsgBox strMsg Exit Sub errHandler: Resume exitHandler

End Sub

/ 0 نظر / 25 بازدید