בקשה | פקודות מקרו בוורד.
תוכנה
34
פוסטים
6
כותבים
1.1k
צפיות
5
עוקבים
-
-
@הללוהו
בעמודה A באקסל תרשום בראשית שמות וכו'
אחד אחרי השני כל תא שם לחיפוש והחלפה
מה שהקוד הזה יעשה הוא יחליף את הסוגריים -
-
@אוריי הוא כבר כתב לעיל, על מה שהבאת שזה עובד!
-
@הללוהו
אני יביא את הקוד שעשיתי יש עוד מה לשפר אבל הרעיון עובד- תיצור קובץ אקסל ותכניס בעמודה A את כל הערכים לחיפוש תקרא לו שם ותשמור ולסגור את הקובץ.
- תכניס בוורד את הקוד הבא
Sub HighlightMatchesAndSummarize() Dim strArray As String 'GET DATA FROM EXCEL Dim xlApp As Object Dim xlBook As Object Const strWorkBookName As String = "C:\Users\User\Documents\uri.xlsx" On Error Resume Next Set xlApp = GetObject(, "Excel.Application") If Err Then Set xlApp = CreateObject("Excel.Application") End If On Error GoTo 0 Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkBookName) 'xlApp.Visible = True xlApp.Visible = False 'transpose excel cells in our arrays Dim w w = 1 Do While xlApp.ActiveSheet.range("a" & w) <> "" strArray = xlApp.ActiveSheet.range("A" & w).Value Search (strArray) w = w + 1 Loop Set xlBook = Nothing xlApp.Quit Set xlApp = Nothing End Sub Public Function Search(text As String) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .text = "\((*)" & text & "(*)\)" .Replacement.text = "{\1" & text & "\2}" .Forward = True .Wrap = wdFindContinue .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll End Function- תשנה בשורה 6 את המיקום של הקובץ אקסל שיצרת
ונשאר לך פשוט להפעיל את המאקרו
בהצלחה
-
@אוריי הוא משבש אותי וכותב לי שגיאה (לאחרונה, בתחילה כן עבד לי ועכשיו עם מחשב אחר..) בשורה 31 הנ"ל.
אם ידוע לך פיתרון אשמח לשמוע. -
@אוריי הקוד הוא אותו קוד שכתבת ועם כתיבת השורות ניסיתי שוב את הקוד על מחשב אחר וכן הצלחתי אבל במחשב שאני משתמש בו הוא מכריז לי שגיאה על השורה הנ"ל 31
והוא נצבע כך בכחול השאילה אם יש סוגי מחשבים ששם צריך לכתוב מילים אחרות?
