Erweitern Sie die Kommentarauswahl in Microsoft Word

Normalerweise kopiere ich einfach den Kommentartext in die Zwischenablage, lösche den Kommentar und erstelle dann einen neuen Kommentar für den korrekten Text.

Das folgende Makro automatisiert dies:

Sub enlarge_comment() 'assumes that the current selection contains just one comment! Dim newrange As Range Set newrange = Selection.Range Selection.Comments(1).Range.Copy 'copy text of old comment Selection.Comments.Add Range:=newrange 'create new comment Selection.Paste 'add text to new comment newrange.Comments(1).Delete 'delete old comment End Sub 

Ich verwende die Zwischenablage, um sicherzugehen, dass die Formatierung des Kommentars (z. B. verschiedene Schriftarten) nicht verloren geht. Ich habe jedoch nicht getestet, ob es einen einfacheren Weg gibt. Das Ergebnis ist folgendes:

Natürlich möchten Sie vielleicht eine Art Fehlerbehandlung hinzufügen. Wenn in der ausgewählten Region mehr als ein Kommentar vorhanden ist, wird alles genommen, was Word für das erste hält. Ihre neue Auswahl muss die alte Auswahl vollständig enthalten. ansonsten Selection.Commentsist leer und Selection.Comments(1).Range.Copyschlägt fehl.

Ich habe gerade herausgefunden, wie man expand or shrink the selected comment area ohne ein Makro schreibt oder den Kommentar schneidet / kopiert / löscht (In Word 10):

GEHEN SIE ZUM ENTWURFSANSICHT . Sie sehen Ihren Kommentar zwischen 'Ziehpunkten' mit dem Kommentarsymbol an der Seite [in eckigen Klammern].

INSERT (Ausschneiden und Einfügen), um den Kommentarbereich zu erweitern oder zu verkleinern.

Beispiel: Die [AB1] ist heute kalt . Verschieben Sie nun zusätzlichen Text in den Griff.

Beispiel: Die [AB1] heute, auf diese Weise haben Sie den Kommentarbereich erweitert (wenn Sie Text aus ihm heraus verschieben, wird er verkleinert).

PS: Das Leerzeichen vor dem} ist erforderlich, ohne dass Sie dies tun können.

Ich hoffe es hilft

Hier ist meine ziemlich vollständige Lösung, basierend auf der Lösung von Jonas Heidelberg, oben:

Sub ChangeCommentSpan() ' 'If the current selection range is larger than the comment its spans, this macro expands the document-scope 'range of the comment to encompass the entire current selection's range. Alternatively, if the current 'selection range is smaller than the comment spanned by it, this macro reduces the document-scope range of 'the comment to encompass only the current selection's range. ' 'AUTHOR: Peter Straton ' 'CREDIT: Derived from Jonas Heidelberg's solution at: ' https://superuser.com/questions/159765/expand-comment-select-in-microsoft-word ' '*************************************************************************************************************  Const ExpandUnits As Integer = wdWord 'Alternatively, could use wdCharacter  Dim CheckRng Dim DocTextSelRng As Range Dim EndBackward As Boolean Dim EndForward As Boolean Dim Forward As Boolean Dim OrigCmnt As Comment Dim MovedEndUnits As Long Dim MovedStartUnits As Long  'First check whether the selection includes (overlaps onto) one and only one comment.  With Selection If .Comments.Count > 1 Then MsgBox "The selected range includes more than one Word comment. Unable to determine which " & _ "comment is to be expanded.", vbOKOnly + vbCritical, "SELECTION ERROR" Exit Sub End If  Set DocTextSelRng = .Range.Duplicate 'Capture the current Selection range (the document-text range) 'because the Selection object's range will change to be the new 'comment's (internal) Text range when the new comment is added. End With  'Sometimes the user fails to span the current-comment's scope range (or span the whole comment) with their 'manual selection, resulting in the targeted comment being undetectable using the Selection object's range. 'So check for that case using a copy of the selected range and, if necessary, progressively expand it one 'character at a time, alternating left and then right, until at least one overlapping comment is found.  Set CheckRng = DocTextSelRng.Duplicate With CheckRng While .Comments.Count = 0 If Forward Then If Not EndForward Then MovedEndUnits = .MoveEnd(ExpandUnits, 1) EndForward = (MovedEndUnits = 0) End If Forward = EndBackward Else If Not EndBackward Then MovedStartUnits = .MoveStart(ExpandUnits, -1) EndBackward = (MovedStartUnits = 0) End If Forward = Not EndForward End If  If EndForward And EndBackward Then 'The range was expanded to include the whole document text and no comment was found.  MsgBox "The active document includes no Comments.", vbOKOnly + vbCritical, "NO COMMENTS FOUND" Exit Sub End If Wend Set OrigCmnt = .Comments(1)  'Found the nearest Comment so check whether it overlaps the originally selected range.  'IMPORANT: Start and End values are insertion-point locations, not character positions. So the Start 'property of a Comment object's Scope range may be the same value as the End value of the character 'immediately to its left and the End property of a Comment Scope range may be the same value as the 'Start value of the character immediately to its right. Therefore, the following conditional test 'must use "<=" and ">=", respectively, not just "<" and ">":  If (DocTextSelRng.End <= OrigCmnt.Scope.Start) Or (DocTextSelRng.Start >= OrigCmnt.Scope.End) Then 'The found Comment does not overlap onto the original selected range, so inform user and exit.  MsgBox "The selected range includes no Comments.", vbOKOnly + vbCritical, "SELECTION ERROR" Exit Sub End If End With  'Expand (or reduce) the comment to include all of (or only) the selected range.  OrigCmnt.Range.Copy 'Copy the (internal) text of the existing comment DocTextSelRng.Comments.Add Range:=DocTextSelRng 'Create a new comment that spans the selected document scope  'Paste the original Comment's (internal) text and its formatting as the new Comment's (internal) text  Selection.Paste 'NOTE: This is the now-current Selection which is the new Comment's (internal) text 'range (not the Comment's scope range, which spans the document-text it applies to).  OrigCmnt.Delete 'Delete the original comment  'Finally, close the Comments pane that was automatically opened by the Comments.Add method call, above.  If WordBasic.ViewAnnotations = -1 Then WordBasic.ViewAnnotations 0 End If End Sub