שלום רב.
פעמים רבות יש לי שני קבצי וורד שאני מעוניין להעתיק מילה שהשחרתי באחד מהם, לעבור לקובץ השני, לפתוח את חלונית החיפוש, להדביק ולחפש, ביקשתי מצ'אטgpt שיתן לי מאקרו לזה, ולאחר שעות ארוכות של התכתבות חוזרת ונשנית, הצלחתי רק להגיע למאקרו שעושה את הפעולה, אבל מבלי לפתוח את חלונית הניווט - וממילא כמעט ולא עוזר לי. מישהו יודע על מאקרו שיכול לעשות את העבודה? תודה רבה.
Sub CopyAndSearch() Dim sourceDoc As Document Dim targetDoc As Document Dim selectedText As String Dim foundDoc As Boolean Dim occurrences As Long Dim searchRange As Range ' נניח שנמצאים בקובץ הראשון Set sourceDoc = ActiveDocument ' בדוק אם יש טקסט נבחר If Selection.Type <> wdNoSelection Then selectedText = Trim(Selection.Text) ' נחתוך רווחים מסביב Else MsgBox "אף מילה לא נבחרה." Exit Sub End If ' חפש קובץ שני פתוח foundDoc = False For Each targetDoc In Documents If targetDoc.Name <> sourceDoc.Name Then foundDoc = True Exit For End If Next targetDoc If Not foundDoc Then MsgBox "לא נמצא קובץ שני פתוח." Exit Sub End If ' הכן את חפיש התוכן בקובץ השני Set searchRange = targetDoc.Content occurrences = 0 ' אתחול מספר המופעים ' חפש במילה בקובץ השני With searchRange.Find .ClearFormatting .Text = selectedText .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .Execute Forward:=True ' אם נמצאה המילה If .Found Then occurrences = occurrences + 1 targetDoc.Activate searchRange.Select MsgBox "המילה '" & selectedText & "' נמצאה במופע מספר " & occurrences & "." Do While .Execute(Forward:=True) occurrences = occurrences + 1 targetDoc.Activate searchRange.Select MsgBox "המילה '" & selectedText & "' נמצאה במופע מספר " & occurrences & "." Dim nextAction As VbMsgBoxResult nextAction = MsgBox("האם תרצה לעבור למופע הבא?", vbYesNo) If nextAction = vbNo Then Exit Do Loop Else MsgBox "המילה '" & selectedText & "' לא נמצאה בקובץ '" & targetDoc.Name & "'." End If End With End Sub