• הרשמה
    • התחברות
    • חיפוש
    • פוסטים אחרונים
    • לא נפתר
    • MT
    • משתמשים
    • חיפוש גוגל בפורום
    • צור קשר

    חוקי הפורום

    מדריך לשימוש בפורום

    שאלה | חיפוש והחלפה בהרבה קבצי וורד ביחד

    עזרה הדדית - מחשבים וטכנולוגיה
    2
    4
    77
    טוען פוסטים נוספים
    • מהישן לחדש
    • מהחדש לישן
    • הכי הרבה הצבעות
    תגובה
    • הגיבו כנושא
    התחברו בכדי לפרסם תגובה
    נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
    • ש
      ש. בר. נערך לאחרונה על ידי

      האם אפשר להחליף מילה מסויימת בהרבה קבצי וורד ביחד?

      צ תגובה 1 תגובה אחרונה תגובה ציטוט 0
      • צ
        צבי 10 @ש. בר. נערך לאחרונה על ידי צבי 10

        @ש-בר אם אתה יודע מה זה VBA (תכנות ביישומי אופיס) אז כאן אולי יכול לעזור לך (סליחה שאין לי כח לעבור על זה כעת..)
        או שיש פתרונות אחרים שאני לא מכיר. מסקנת הפוסט שם, מצורפת כאן.

        Dim FSO As Object, oFolder As Object, StrFolds As String
         
        Sub Main()
        Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long
        TopLevelFolder = GetFolder
        If TopLevelFolder = "" Then Exit Sub
        StrFolds = vbCr & TopLevelFolder
        If FSO Is Nothing Then
          Set FSO = CreateObject("Scripting.FileSystemObject")
        End If
        'Get the sub-folder structure
        Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders
        For Each aFolder In TheFolders
          RecurseWriteFolderName (aFolder)
        Next
        'Process the documents in each folder
        For i = 1 To UBound(Split(StrFolds, vbCr))
          Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i)))
        Next
        End Sub
         
         
        Sub RecurseWriteFolderName(aFolder)
        Dim SubFolders As Variant, SubFolder As Variant
        Set SubFolders = FSO.GetFolder(aFolder).SubFolders
        StrFolds = StrFolds & vbCr & CStr(aFolder)
        On Error Resume Next
        For Each SubFolder In SubFolders
          RecurseWriteFolderName (SubFolder)
        Next
        End Sub
        
        
        Sub UpdateDocuments(oFolder As String)
        Application.ScreenUpdating = False
        Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document
        strInFolder = oFolder
        strFile = Dir(strInFolder & "\*.docx", vbNormal)
        'Check for documents in the folder - exit if none found
        If strFile <> "" Then strOutFold = strInFolder & "\Output\"
        'Test for an existing outpfolder & create one if it doesn't already exist
        If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
        strFile = Dir(strInFolder & "\*.docx", vbNormal)
        While strFile <> ""
          Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
          With wdDoc
            With .Range.Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
              .MatchSoundsLike = False
              .MatchAllWordForms = False
              .Text = "["
              .Replacement.Text = "~"
              .Execute Replace:=wdReplaceAll
              .Text = "]"
              .Replacement.Text = "~"
              .Execute Replace:=wdReplaceAll
              .MatchWildcards = True
              .Text = "~*~"
              .Replacement.Text = " "
              .Execute Replace:=wdReplaceAll
            End With
            'Save and close the document
            .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
            .Close
          End With
          strFile = Dir()
        Wend
        Set wdDoc = Nothing
        Application.ScreenUpdating = True
        End Sub
         
        Function GetFolder() As String
        Dim oFolder As Object
        GetFolder = ""
        Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
        If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
        Set oFolder = Nothing
        End Function
        
        ש תגובה 1 תגובה אחרונה תגובה ציטוט 0
        • ש
          ש. בר. @צבי 10 נערך לאחרונה על ידי

          @צבי-10
          תודה על התגובה
          לא יודע מה זה VBA
          מה שצירפת אמור לעשות את מה שרציתי?

          צ תגובה 1 תגובה אחרונה תגובה ציטוט 0
          • צ
            צבי 10 @ש. בר. נערך לאחרונה על ידי

            @ש-בר כן ולא.
            כן אחרי שאתה לומד לעומק איפה להניח את הקבצים איך לקרוא להם וכו'
            אולי מישהו ירצה לעזור לך - אני עמוס כרגע. (וגם לא משהו ב VBA)

            תגובה 1 תגובה אחרונה תגובה ציטוט 0

            • פוסט ראשון
              פוסט אחרון