вопрос по vba

[Robert]

написал программу на vba которая в указанном каталоле изменяет заданный текст в файлах *.doc на какой-либо другой и почти сразу столкнулся с проблемой, прога не изменяет текст в некоторых таблицах документа (помоему в тех которые воспринимаются как отдельные объекты), а просто пропускает их... помогите пожалуйста с этим куском

у меня он довольно примитивный и выглядит вот так:

Код:

              ...
   Documents.Open FileName:=FindDir
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = text1
        .Replacement.Text = text2
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveDocument.Save
    ActiveDocument.Close
             ...

[Robert]

что-то мне подсказывает что на этом форуме мне никто не поможет...  или может быть я не в той теме прошу помочь?

[Sla]

тема та, да видимо "буйные" в отпуске

[Robert]

ок... буду ждать ответа 
сам я врятли разберусь с данной задачей, т.к. язык начал учить недавно и мало что понимаю

[Джон]

Я думаю, что вопрос всё-таки не начинающего. Или?

Может тут поактивней будет.

[RXL]

Если не вдаваться в реализацию (тем более, что в VBA совета я дать не смогу), то нужно как-то перечислить строенные в документ объекты и определить их тип. Если тип тоже вордовый, то совершить с ним, подобное описанному в первом посте, действие.

[HandKot]

не изменяет текст в некоторых таблицах документа (помоему в тех которые воспринимаются как отдельные объекты), а просто пропускает их... помогите пожалуйста с этим куском

выложите пример файла, дабы точно все посмотреть

[Robert]

ээээ... ну например этот файл, там макрос этот уже есть =)

[HandKot]

как-то он не скачмвается

[Sla]

все-таки плохая привычка давать именам файлов русские имена.

[Robert]

сорьки...

[Sla]

не хочется сильно втыкать, но нужно задать область поиска

[Robert]

эээ, а поподробнее можно? каким образом? он поидее и так весь текст должен просматривать

[Sla]

это ведь по идее
А идея у него одна - программерам и продвинутым юзерам кушать хочется

ну там есть всякие shape и прочее, я ж говорю не хотца сильно втыкать

[Sla]

как-нибудь так

Код:

For Each rng In ActiveDocument.StoryRanges
     Do
     Select Case rng.StoryType
     Case 6, 7, 8, 9, 10, 11
          If rng.ShapeRange.Count > 0 Then
               For Each obj In rng.ShapeRange
                    If obj.TextFrame.HasText Then
'менять                         
            End If
               Next
          End If
     Case Else

     End Select
     Loop Until rng Is Nothing
Next

[Robert]

хм... я в этом коде вообще не разобрался 

[Sla]

убери цикл do loop
посмотри какие значения принимает StoryType

rng, obj - коллекция объектов.

[Robert]

в rng, obj я уже разобрался...
а почему case 6,7,8,9,10,11?
тут какой-то косяк... прога с циклом не работает, хотя может это и я туплю где-то =( ... а скорее всего и то и другое

[Robert]

все ... догнал и с кейсом

[Sla]

вот гляди, дарю!

Код:

Public Sub BatchReplaceAnywhere()
'Based on a macro by Doug Robbins
'with additional input from Peter Hewett
'and Greg Maxey to replace text in all
'the documents in a folder, wherever that text appears.

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim rngstory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape

 

'*******************************************************
' Use this folder selection for Word versions 2002-7
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

' Get the folder containing the files
With fDialog
     .Title = "Select Folder containing the documents to be modified and click OK"
     .AllowMultiSelect = False
     .InitialView = msoFileDialogViewList
     If .Show <> -1 Then
          MsgBox "Cancelled By User", , "Batch Replace Anywhere"
          Exit Sub
     End If
     PathToUse = fDialog.SelectedItems.Item(1)
     If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse + "\"
End With

'Close any documents that may be open
If Documents.Count > 0 Then
     Documents.Close Savechanges:=wdPromptToSaveChanges
End If
FirstLoop = True

 

'*******************************************************

'End of Folder selectiom

 

'*******************************************************
'Alternative folder selection for older Word versions


'With Dialogs(wdDialogCopyFile)
' If .Display <> 0 Then
' PathToUse = .Directory
' Else
' MsgBox "Cancelled by User"
' Exit Sub
' End If
'End With

'If Documents.Count > 0 Then
' Documents.Close Savechanges:=wdPromptToSaveChanges
'End If
'
'FirstLoop = True
'
'If Left(PathToUse, 1) = Chr(34) Then
' PathToUse = Mid(PathToUse, 2, Len(PathToUse) - 2)
'End If
'**********************************************************

'End of folder selection version 2

 

myFile = Dir$(PathToUse & "*.doc")
 

While myFile <> ""
'Get the text to be replaced and the replacement
     If FirstLoop = True Then
          pFindTxt = InputBox("Enter the text that you want to replace.", _
                     "Batch Replace Anywhere")
If pFindTxt = "" Then
     MsgBox "Cancelled by User", , _
            "Batch replace Anywhere"
Exit Sub
End If
 

Tryagain:
pReplaceTxt = InputBox("Enter the replacement text.", _
                       "Batch ReplaceAnywhere ")
If pReplaceTxt = "" Then
     If MsgBox("Do you just want to delete the found text?", _
        vbYesNoCancel, "Batch Replace Anywhere") = vbNo Then
           GoTo Tryagain
     ElseIf vbCancel Then
          MsgBox "Cancelled by User.", , "Batch Replace Anywhere"
          Exit Sub
     End If
End If
End If
FirstLoop = False
 

'Open each file and make the replacement
Set myDoc = Documents.Open(PathToUse & myFile)
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngstory In ActiveDocument.StoryRanges
'Iterate through all linked stories
     Do
          SrcAndRplInStory rngstory, pFindTxt, pReplaceTxt
     On Error Resume Next
     Select Case rngstory.StoryType
     Case 6, 7, 8, 9, 10, 11
          If rngstory.ShapeRange.Count > 0 Then
               For Each oShp In rngstory.ShapeRange
                    If oShp.TextFrame.HasText Then
                         SrcAndRplInStory oShp.TextFrame.TextRange, _
                         pFindTxt, pReplaceTxt
                    End If
               Next
          End If
     Case Else
     'Do Nothing
     End Select
     On Error GoTo 0
     'Get next linked story (if any)
     Set rngstory = rngstory.NextStoryRange
     Loop Until rngstory Is Nothing
Next
'Close the file, saving the changes.
myDoc.Close Savechanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub

Public Sub SrcAndRplInStory(ByVal rngstory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngstory.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .Text = strSearch
     .Replacement.Text = strReplace
     .Execute Replace:=wdReplaceAll
End With
End Sub

Sub ResetFRParameters()
With Selection.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .Text = ""
     .Replacement.Text = ""
     .Forward = True
     .Wrap = wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = False
     .MatchWildcards = False
     .MatchSoundsLike = False
     .MatchAllWordForms = False
     .Execute
End With
End Sub

макрос сохрани в нормал.дот и тренируйся!
украдено  здесь

[Robert]

я в той еще доконца не догнал а ты мне эту подарил 
ну ладно спасибо... буду изучать 

[Robert]

ОооО!!! спасибо большое =))) хорошая прога, ты мну кусок с нее кинул... естественно он не будет работать =)...

[Robert]

А какой командой можно макрос из документа добавить в общий шаблон Normal.dotm?

[Sla]

а ручками слабо?
или
создать свою надстройку?

пихать макросы в нормал дот - вредно!

[Robert]

ну смотри... я же не все подряд сую... допустим мне надо кинуть эту прогу кому-то... я кину ему ворд с макросом, а он запустив макрос копирует его в normal.dotm... я же не смогу ему макрос прямо в шаблон с файлом кинуть, тем более эта прога работает только в нормал.дотм

[Sla]

сделай свой шаблон, с со своим макросом, и отдай его кому-то

[Robert]

и из него эта прога будет работать на другом компе под любым профилем?
как его сделать подскажи, а то у мну руки кривые =)...

[Sla]

я в том коде сильно не разбирался, но, к сожалению, перед работой она закрывает все открытые файлы.
А шаблон сделать - как два пальца. Просто сохраняешь вордовый документ как шаблон, а затем при открытии шаблона ворд сам создаст документ на основании твоего шаблона.
Немного покопаться в коде, сделать более дружественный интерфейс.

[Robert]

Во! Так тоже все работает   
Спасибо тебе огромное за помощь! Выручил