1 Тема от Ztanusha

  • Ztanusha
  • рядовой
  • Неактивен
  • Зарегистрирован: 25.11.2016
  • Сообщений: 8

Тема: Как автоматизировать подгонку страниц?

У меня вопрос: можно ли как то установить автоматическую подгонку страниц в документе WORD? Т.е. например в договор вписывается перечень услуг, их может быть много или мало, но требование такое , что бы договор не превышал двух страниц ...т.е шрифт или межстрочный интервал должны изменяться автоматически.

2 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171
  • За сообщение: 1

Re: Как автоматизировать подгонку страниц?

Ztanusha пишет:

У меня вопрос: можно ли как то установить автоматическую подгонку страниц в документе WORD? Т.е. например в договор вписывается перечень услуг, их может быть много или мало, но требование такое , что бы договор не превышал двух страниц ...т.е шрифт или межстрочный интервал должны изменяться автоматически.

Изменение размера шрифта поможет вам меньше, чем изменение межстрочного интервала (размер шрифта вы сможете установить вручную). Предлагаю такой подход: разметить документ закладками на тех группах абзацев, которые допускают изменение межстрочного интервала. Такие закладки должны иметь общий префикс имени (допустим, "Resize"). Тогда макрос обходит все такие закладки и в абзацах этих диапазонов изменяет межстрочный интервал. Макросы, которые представлены ниже:
IncreaseSpacingInResizableRanges - увеличить межстрочный интервал в целевых закладках
DecreaseSpacingInResizableRanges - уменьшить межстрочный интервал в целевых закладках
AdjustDocToSize - подогнать документ к целевому размеру (этот размер указан в константе target_doc_size (ее надо назначать осмысленно, т.к. могут быть ситуации, когда целевого размера документа в страницах можно не достичь ввиду наличия разрывов страниц в документе), разрывов страниц в документе следует избегать при пользовании этими макросами.
Первые два макроса можно использовать как самостоятельно (назначив им горячие клавиши), так и в составе третьего макроса.

Sub IncreaseSpacingInResizableRanges()
Dim bmk As Bookmark
Dim para As Paragraph
Dim cur_line_spacing As Variant
Dim bmk_para_linespacing As Variant
Const undefined_para_linespacing As Variant = 9999999
Const para_def_line_spacing As Variant = 10
Const para_linespacing_resizefactor As Variant = 1.2
Const ResizeBmkPrefix As String = "Resize"
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_para_linespacing = bmk.Range.ParagraphFormat.LineSpacing
        On Error Resume Next
        If bmk_para_linespacing = undefined_para_linespacing Then
            bmk.Range.ParagraphFormat.LineSpacing = para_def_line_spacing
            bmk.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        End If
        For Each para In bmk.Range.Paragraphs
            cur_line_spacing = para.Range.ParagraphFormat.LineSpacing
                para.Range.ParagraphFormat.LineSpacing = _
                    cur_line_spacing * para_linespacing_resizefactor
                para.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        Next
        On Error GoTo 0
    End If
Next
End Sub

Sub DecreaseSpacingInResizableRanges()
Dim bmk As Bookmark
Dim para As Paragraph
Dim cur_line_spacing As Variant
Dim bmk_para_linespacing As Variant
Const undefined_para_linespacing As Variant = 9999999
Const para_def_line_spacing As Variant = 10
Const para_linespacing_resizefactor As Variant = 1.2
Const ResizeBmkPrefix As String = "Resize"
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_para_linespacing = bmk.Range.ParagraphFormat.LineSpacing
        On Error Resume Next
        If bmk_para_linespacing = undefined_para_linespacing Then
            bmk.Range.ParagraphFormat.LineSpacing = para_def_line_spacing
            bmk.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        End If
        For Each para In bmk.Range.Paragraphs
            cur_line_spacing = para.Range.ParagraphFormat.LineSpacing
                para.Range.ParagraphFormat.LineSpacing = _
                    cur_line_spacing / para_linespacing_resizefactor
                para.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        Next
        On Error GoTo 0
    End If
Next
End Sub

Sub AdjustDocToSize()
Dim init_doc_size As Long
Dim bmk_cnt As Long
Dim bmk As Bookmark
Const target_doc_size As Long = 2
bmk_cnt = 0
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_cnt = bmk_cnt + 1
    End If
Next
If bmk_cnt = 0 Then
    MsgBox "No resizeable bookmarked range is found in the document"
Else
    init_doc_size = Selection.Information(wdNumberOfPagesInDocument)
    If init_doc_size <> target_doc_size Then
        If init_doc_size > target_doc_size Then 'need to decrease linespacing
            While (Selection.Information(wdNumberOfPagesInDocument) > target_doc_size)
                DecreaseSpacingInResizableRanges
            Wend
        Else
            While (Selection.Information(wdNumberOfPagesInDocument) < target_doc_size)
                IncreaseSpacingInResizableRanges
            Wend
        End If
    End If
End If
End Sub

Сайтyshindin

3 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171
  • За сообщение: 1

Re: Как автоматизировать подгонку страниц?

yshindin пишет:

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

Я подумал, что все-таки следует ограничить предельное число операций изменения межстрочного интервала ввиду того, что цикл While может зациклиться из-за невозможности достижения целевого числа страниц в документе по любой причине, напр., при наличии в документе тех же разрывов страниц. В доработанном варианте макроса AdjustDocToSize (приведен ниже) введено максимальное число циклов обработки max_cnt_resize. При его достижении обработка прекращается с выдачей соответствующего сообщения.
Еще одно замечание: значение межстрочного интервала не может быть бесконечно большим или бесконечно малым - при выходе за границы допустимых размеров (менее 0,7 pt или более 1584 pt) Word выдает сообщение об ошибке. При необходимости следует учесть это программно путем анализа нового значения межстрочного интервала в макросах IncreaseSpacingInResizableRanges и DecreaseSpacingInResizableRanges: если новое значение выходит за допустимый предел, то выполнить выход из макроса.

Sub AdjustDocToSize()
Dim init_doc_size As Long
Dim bmk_cnt As Long
Dim bmk As Bookmark
Dim i_cnt_resize As Long
Const target_doc_size As Long = 2
Const max_cnt_resize As Long = 20
bmk_cnt = 0
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_cnt = bmk_cnt + 1
    End If
Next
If bmk_cnt = 0 Then
    MsgBox "No resizeable bookmarked range is found in the document"
Else
    init_doc_size = Selection.Information(wdNumberOfPagesInDocument)
    i_cnt_resize = 0
    If init_doc_size <> target_doc_size Then
        If init_doc_size > target_doc_size Then 'need to decrease linespacing
            While (Selection.Information(wdNumberOfPagesInDocument) > target_doc_size)
                DecreaseSpacingInResizableRanges
                i_cnt_resize = i_cnt_resize + 1
                If i_cnt_resize > max_cnt_resize Then
                    GoTo e_ADTS
                End If
            Wend
        Else
            While (Selection.Information(wdNumberOfPagesInDocument) < target_doc_size)
                IncreaseSpacingInResizableRanges
                i_cnt_resize = i_cnt_resize + 1
                If i_cnt_resize > max_cnt_resize Then
                    GoTo e_ADTS
                End If
            Wend
        End If
    End If
End If
e_ADTS:
If i_cnt_resize > max_cnt_resize Then
    MsgBox "Resizing has been stopped: number of resize limit is reached"
End If
End Sub

Сайтyshindin

4 Ответ от yshindin

  • yshindin
  • генерал-полковник
  • Неактивен
  • Откуда: Москва
  • Зарегистрирован: 12.05.2012
  • Сообщений: 447
  • Поблагодарили: 171
  • За сообщение: 1

Re: Как автоматизировать подгонку страниц?

yshindin пишет:

Еще одно замечание: значение межстрочного интервала не может быть бесконечно большим или бесконечно малым - при выходе за границы допустимых размеров (менее 0,7 pt или более 1584 pt) Word выдает сообщение об ошибке. При необходимости следует учесть это программно путем анализа нового значения межстрочного интервала в макросах IncreaseSpacingInResizableRanges и DecreaseSpacingInResizableRanges: если новое значение выходит за допустимый предел, то выполнить выход из макроса.

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

Sub IncreaseSpacingInResizableRanges()
Dim bmk As Bookmark
Dim para As Paragraph
Dim cur_line_spacing As Variant
Dim bmk_para_linespacing As Variant
Dim next_line_spacing As Variant
Const undefined_para_linespacing As Variant = 9999999
Const para_def_line_spacing As Variant = 10
Const para_linespacing_resizefactor As Variant = 1.2
Const ResizeBmkPrefix As String = "Resize"
Const max_line_spacing As Variant = 1584
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_para_linespacing = bmk.range.ParagraphFormat.LineSpacing
        On Error Resume Next
        If bmk_para_linespacing = undefined_para_linespacing Then
            bmk.range.ParagraphFormat.LineSpacing = para_def_line_spacing
            bmk.range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        End If
        For Each para In bmk.range.Paragraphs
            cur_line_spacing = para.range.ParagraphFormat.LineSpacing
            next_line_spacing = cur_line_spacing * para_linespacing_resizefactor
            If next_line_spacing <= max_line_spacing Then
                para.range.ParagraphFormat.LineSpacing = next_line_spacing
                para.range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
            Else
                Exit Sub
            End If
        Next
        On Error GoTo 0
    End If
Next
End Sub

Sub DecreaseSpacingInResizableRanges()
Dim bmk As Bookmark
Dim para As Paragraph
Dim cur_line_spacing As Variant
Dim bmk_para_linespacing As Variant
Dim next_line_spacing As Variant
Const undefined_para_linespacing As Variant = 9999999
Const para_def_line_spacing As Variant = 10
Const para_linespacing_resizefactor As Variant = 1.2
Const ResizeBmkPrefix As String = "Resize"
Const min_line_spacing As Variant = 0.7
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_para_linespacing = bmk.range.ParagraphFormat.LineSpacing
        On Error Resume Next
        If bmk_para_linespacing = undefined_para_linespacing Then
            bmk.range.ParagraphFormat.LineSpacing = para_def_line_spacing
            bmk.range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
        End If
        For Each para In bmk.range.Paragraphs
            cur_line_spacing = para.range.ParagraphFormat.LineSpacing
            next_line_spacing = cur_line_spacing / para_linespacing_resizefactor
            If next_line_spacing >= min_line_spacing Then
                para.range.ParagraphFormat.LineSpacing = next_line_spacing
                para.range.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
            Else
                Exit Sub
            End If
        Next
        On Error GoTo 0
    End If
Next
End Sub

Sub AdjustDocToSize()
Dim init_doc_size As Long
Dim bmk_cnt As Long
Dim bmk As Bookmark
Dim i_cnt_resize As Long
Const target_doc_size As Long = 2
Const max_cnt_resize As Long = 20
bmk_cnt = 0
For Each bmk In ActiveDocument.Bookmarks
    If InStr(bmk.name, ResizeBmkPrefix) = 1 Then 'this is resizable range
        bmk_cnt = bmk_cnt + 1
    End If
Next
If bmk_cnt = 0 Then
    MsgBox "No resizeable bookmarked range is found in the document"
Else
    init_doc_size = Selection.Information(wdNumberOfPagesInDocument)
    i_cnt_resize = 0
    If init_doc_size <> target_doc_size Then
        If init_doc_size > target_doc_size Then 'need to decrease linespacing
            While (Selection.Information(wdNumberOfPagesInDocument) > target_doc_size)
                DecreaseSpacingInResizableRanges
                i_cnt_resize = i_cnt_resize + 1
                If i_cnt_resize > max_cnt_resize Then
                    GoTo e_ADTS
                End If
            Wend
        Else
            While (Selection.Information(wdNumberOfPagesInDocument) < target_doc_size)
                IncreaseSpacingInResizableRanges
                i_cnt_resize = i_cnt_resize + 1
                If i_cnt_resize > max_cnt_resize Then
                    GoTo e_ADTS
                End If
            Wend
        End If
    End If
End If
e_ADTS:
If i_cnt_resize > max_cnt_resize Then
    MsgBox "Resizing has been stopped: number of resize limit is reached"
End If
End Sub

Сайтyshindin