Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: вопрос по vba  (Прочитано 30046 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Robert
Гость
« : 21-07-2008 10:54 » 

написал программу на 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
             ...
« Последнее редактирование: 21-07-2008 11:21 от Sla » Записан
Robert
Гость
« Ответ #1 : 23-07-2008 05:58 » 

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

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #2 : 23-07-2008 06:23 » 

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #3 : 23-07-2008 07:13 » 

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

de
Offline Offline
Пол: Мужской

« Ответ #4 : 23-07-2008 12:13 » 

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

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

Я вам что? Дурак? По выходным и праздникам на работе работать. По выходным и праздникам я работаю дома.
"Just because the language allows you to do something does not mean that it’s the correct thing to do." Trey Nash
"Physics is like sex: sure, it may give some practical results, but that's not why we do it." Richard P. Feynman
"All science is either physics or stamp collecting." Ernest Rutherford
"Wer will, findet Wege, wer nicht will, findet Gründe."
RXL
Технический
Администратор

ru
Offline Offline
Пол: Мужской

WWW
« Ответ #5 : 23-07-2008 15:35 » 

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

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
HandKot
Молодой специалист

ru
Offline Offline

« Ответ #6 : 24-07-2008 04:05 » 

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

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

I Have Nine Lives You Have One Only
THINK!
Robert
Гость
« Ответ #7 : 24-07-2008 05:28 » 

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

* Тест1.doc (126 Кб - загружено 979 раз.)
Записан
HandKot
Молодой специалист

ru
Offline Offline

« Ответ #8 : 24-07-2008 07:40 » 

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

I Have Nine Lives You Have One Only
THINK!
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #9 : 24-07-2008 07:53 » 

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #10 : 24-07-2008 11:22 » 

сорьки...

* test1.doc (126 Кб - загружено 1066 раз.)
Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #11 : 24-07-2008 12:44 » 

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #12 : 24-07-2008 13:06 » 

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

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #13 : 24-07-2008 13:09 » 

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

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #14 : 24-07-2008 13:36 » 

как-нибудь так
Код:
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
Гость
« Ответ #15 : 24-07-2008 14:34 » 

хм... я в этом коде вообще не разобрался  С ума сойти...
« Последнее редактирование: 24-07-2008 14:40 от Robert » Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #16 : 24-07-2008 14:54 » 

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

rng, obj - коллекция объектов.
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #17 : 24-07-2008 15:06 » 

в rng, obj я уже разобрался...
а почему case 6,7,8,9,10,11?
тут какой-то косяк... прога с циклом не работает, хотя может это и я туплю где-то =( ... а скорее всего и то и другое
Записан
Robert
Гость
« Ответ #18 : 24-07-2008 15:14 » 

все ... догнал и с кейсом
Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #19 : 24-07-2008 15:17 » 

вот гляди, дарю!
Код:
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
Гость
« Ответ #20 : 24-07-2008 15:24 » 

я в той еще доконца не догнал а ты мне эту подарил  Быть такого не может
ну ладно спасибо... буду изучать  Класс!
Записан
Robert
Гость
« Ответ #21 : 24-07-2008 15:52 » 

ОооО!!! спасибо большое =))) хорошая прога, ты мну кусок с нее кинул... естественно он не будет работать =)...
Записан
Robert
Гость
« Ответ #22 : 25-07-2008 13:14 » 

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

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #23 : 25-07-2008 13:29 » 

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

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #24 : 25-07-2008 13:58 » 

ну смотри... я же не все подряд сую... допустим мне надо кинуть эту прогу кому-то... я кину ему ворд с макросом, а он запустив макрос копирует его в normal.dotm... я же не смогу ему макрос прямо в шаблон с файлом кинуть, тем более эта прога работает только в нормал.дотм
« Последнее редактирование: 25-07-2008 14:00 от Robert » Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #25 : 25-07-2008 14:07 » 

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #26 : 28-07-2008 05:41 » 

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

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #27 : 28-07-2008 06:13 » 

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

Мы все учились понемногу... Чему-нибудь и как-нибудь.
Robert
Гость
« Ответ #28 : 28-07-2008 06:43 » 

Во! Так тоже все работает   Класс!
Спасибо тебе огромное за помощь! Выручил  Улыбаюсь
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines