Rauf Aliev (rauf) wrote,
Rauf Aliev
rauf

Успешно. Разобрался в MS Word Visual Basic, сделал макрос, который вырезал последовательно документ до разделителя и сохранял его в отдельном файле, при этом за имя файла брал заголовок этого раздела, собранный в одну строку (в оригинале он был многострочным). В результате 336 сложноструктурных текстов с таблицами и прочим из одного большого вордовского файла перекочевали в 336 файлов, разбитых по папочкам за час пятнадцать. Вручную там работы на день. А ведь хотел Свете дать, пусть день ковыряется, а нет -- перевесил во мне интерес, а можно ли это автоматизировать...


Selection.HomeKey Unit:=wdLine
    Selection.Find.ClearFormatting
    Selection.Find.Font.Size = 3
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.Cut
    Selection.Delete Unit:=wdCharacter, Count:=1
    Documents.Add DocumentType:=wdNewBlankDocument
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = CentimetersToPoints(1.5)
        .BottomMargin = CentimetersToPoints(1.8)
        .LeftMargin = CentimetersToPoints(2)
        .RightMargin = CentimetersToPoints(1.5)
        .Gutter = CentimetersToPoints(0)
        .HeaderDistance = CentimetersToPoints(1.27)
        .FooterDistance = CentimetersToPoints(1.27)
        .PageWidth = CentimetersToPoints(14.8)
        .PageHeight = CentimetersToPoints(21)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = True
        .TwoPagesOnOne = False
        .GutterPos = wdGutterPosLeft
    End With
    Selection.Paste
    
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Font.Bold = True
    With Selection.Find
        .Text = "^$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Let Prefix = Selection.Text
    If Selection.End - Selection.Start > 1 Then Selection.Cut
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Forward:=True, Replace:=wdReplaceAll
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Forward:=True, Replace:=wdReplaceAll
    With Selection.Find.Font
        .Size = 8
        .Bold = True
        .Superscript = True
        .Subscript = False
    End With
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Copy
    FileName = Selection.Text
    Selection.EndKey Unit:=wdStory
    Selection.HomeKey Unit:=wdStory
    
    If Len(Prefix) > 5 Then GoTo a
    Application.ActiveDocument.SaveAs "c:\dogovor\по частям\Договоры о материальной ответственности\" + Left$(FileName, 230)
    Application.ActiveDocument.Close
    GoTo c
a:
    Selection.TypeText Text:=Prefix
c:
'   Application.Keyboard (1033)
'    Application.ActiveDocument.SaveAs "c:\dogovor\по частям\Договоры купли-продажи, мены, дарения, ренты\" + FileName
'    Application.ActiveDocument.Close

Subscribe

  • Post a new comment

    Error

    default userpic

    Your reply will be screened

    When you submit the form an invisible reCAPTCHA check will be performed.
    You must follow the Privacy Policy and Google Terms of use.
  • 1 comment