Надпись На Каждой Странице Документа

Тема в разделе "Visual Basic", создана пользователем Bob84, 11 дек 2013.

  1. Bob84

    Bob84 Active Member

    Регистрация:
    16 май 2012
    Сообщения:
    38
    Симпатии:
    0
    Здравствуйте.
    Есть вордовский документ, в котором на каждой странице вставлено изображение.
    Макросом рисую поверх изображения надписи на каждой странице:
    Код (LotusScript):
    Sub inscription()
    NumberOfPages = Selection.Information(wdNumberOfPagesInDocument)

    For CurrentPage = 1 To NumberOfPages
    If CurrentPage = 1 Then
    Call Selection.GoTo(wdGoToSection, wdGoToFirst)
    End If

    '================================================================
    STAMP_TEXT1 = "Какой-то текст"
    Dim shp1 As Shape

    Set shp1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    10, 10, Application.InchesToPoints(6), Application.InchesToPoints(10.7))

    shp1.Select

    Selection.InsertAfter (STAMP_TEXT1)

    shp1.Line.Visible = msoFalse
    shp1.TextFrame.VerticalAnchor = msoAnchorBottom
    '================================================================
    Set shp1 = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    Application.InchesToPoints(6.5), _
    Application.InchesToPoints(10), _
    Application.InchesToPoints(1.5), Application.InchesToPoints(1))

    shp1.Select

    Selection.InsertAfter (CurrentPage)

    shp1.Line.Visible = msoFalse
    shp1.TextFrame.VerticalAnchor = msoAnchorBottom
    Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
    '================================================================

    Call Selection.Collapse(wdCollapseEnd)
    Call Selection.GoTo(wdGoToPage, wdGoToNext, 1)

    Next

    Call Selection.Collapse(wdCollapseEnd)

    End Sub
    По какой-то причине код последнюю надпись рисовал на предыдущей странице. Дополнил код вначале добавлением разрыва строки и удалением пустых страниц после цикла.
    Код
    Код (LotusScript):
    Call Selection.GoTo(wdGoToPage, wdGoToLast)
    Selection.EndKey Unit:=wdStory
    Selection.insertbreak Type:=wdPageBreak
    добавил к документы аж две страницы (которые потом кодом же удалял).
    После этого такая ошибка перестала проявлятся.
    Собственно вопрос почему в каких-то случаях не удается добавить надпись на последнюю страницу?
    Спасибо.
     
  2. hosm

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    Посмотри на якорную точку изображения - расположена ли она на последней странице, а также параметры обтекания текстом - возможно, надпись почему-то помещается до изображения. Также есть параметры абзаца, отвечающие за переход на новую страницу и обработку "висячих строк". Замечала, что не всегда корректно проставляется стиль последнего параграфа, иногда сбрасывается на дефолтный. И 2 страницы что-то многовато, одна добавленная должна была помочь. Возможно, просто стоит добавить абзац, к которому прикрепится надпись. Возможно, надпись с изображением не помещаются на странице при определенном режиме просмотра текста? Да и на последней странице вроде как бессмысленно переходить на следующую :)
     
  3. Bob84

    Bob84 Active Member

    Регистрация:
    16 май 2012
    Сообщения:
    38
    Симпатии:
    0
    Понял, буду копать.
    Спасибо
     
  4. Bob84

    Bob84 Active Member

    Регистрация:
    16 май 2012
    Сообщения:
    38
    Симпатии:
    0
    Собственно мне этот макрос был нужен для перевода его потом на LotusScript. Вот что вышло
    Код (LotusScript):
    'высота и ширина для разных ориентаций документа в inches, для A4
    Private Const W_PORTRAIT = 8
    Private Const H_PORTRAIT = 11
    Private Const W_LANDSCAPE = 11
    Private Const H_LANDSCAPE = 8
    ' настройки шрифта для штампа в надписи
    Private Const STAMP_FontName = "Arial"
    Private Const STAMP_FontSize = 12
    Private Const STAMP_FontColor = 16646144
    Private Const STAMP_PageNumColor = wdColorBlack
    ' отступы для надписи, верхняя,нижняя, левая и правая актуальны для tif, tiff и docx. Для doc надпись ужимается до размера текста и выравнивается по нижней границе, т.е. влияют только левая и правая границы
    Private Const TXTBOX_LEFT = 0.5 ' отступ слева для надписи
    Private Const TXTBOX_TOP = 0.5 ' отступ сверху для надписи
    Private Const TXTBOX_RIGHT = 0.5 ' отступ справа для надписи
    Private Const TXTBOX_BOTTOM = 0.1 ' отступ снизу для надписи

    Sub AddStamp( oWord as Variant, oDoc As Variant, StampText as String, StartPageNum  as Integer )
    %REM
    ИИС 121213      
    %END REM

    Dim P_Height As Integer
    Dim P_Width As integer
    Dim AddedText As string
    Dim CurrPageNum As Integer
    Dim CurrentPage As Integer
    Dim NumberOfPages As Integer
    Dim shp As Variant
    Dim tstr As string
    Dim Version As Integer

    On Error GoTo errsub

    P_Width = W_PORTRAIT '8
    P_Height = H_PORTRAIT '11
    If oDoc.PageSetup.Orientation = wdOrientLandscape Then
    P_Width = W_LANDSCAPE '11
    P_Height = H_LANDSCAPE '8
    End If

    CurrPageNum = 0
    AddedText = StampText
    If AddPageNum Then
    CurrPageNum = StartPageNum     
    End If
    If Len( AddedText ) = 0 Then
    If CurrPageNum = 0 Then
    Exit Sub
    End If     
    End If
    'Stop
    'oDoc.Application.Visible = true
    ' цикл по страницам
    tstr = oWord.Version
    If Len( strleft( tstr, "." ) ) > 0 Then
    tstr = StrLeft( tstr, "." )
    End If
    Version = CInt( tstr ) ' 12 2007 14 2010
    NumberOfPages = oDoc.ComputeStatistics(2)
    tstr = "/" & CStr(NumberOfPages)
    For CurrentPage = 1 To NumberOfPages
    Print "Страница " & CStr( CurrentPage ) & tstr
    If CurrentPage = 1 Then
    Call oWord.Selection.GoTo(wdGoToSection, wdGoToFirst)
    End If

    Set shp = oDoc.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    oWord.InchesToPoints(TXTBOX_LEFT),_ 'Left
    oWord.InchesToPoints(TXTBOX_TOP),_ ' Top
    oWord.InchesToPoints(CDbl(P_Width) - TXTBOX_RIGHT),_ ' Width
    oWord.InchesToPoints(CDbl(P_Height)-TXTBOX_BOTTOM)) ' Height

    shp.Select

    oWord.Selection.InsertAfter ( AddedText )

    shp.Line.Visible = msoFalse
    If Version >= 14 Then ' 2010 end higher
    shp.TextFrame.VerticalAnchor = msoAnchorBottom
    End If

    oWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight

    oWord.Selection.Font.Name = STAMP_FontName
    oWord.Selection.Font.Size = STAMP_FontSize
    oWord.Selection.Font.Color = STAMP_FontColor

    If CurrPageNum > 0 Then
    Call oWord.Selection.MoveRight( wdCharacter, 1 )
    oWord.Selection.InsertAfter ( Chr(10) & Chr(10) & CStr( CurrPageNum ) )
    oWord.Selection.Font.Color = STAMP_PageNumColor
    End If

    If LCase( Strrightback( oDoc.Name, "." ) ) = "doc" Then 'Or oDoc.CompatibilityMode = 11 Then
    Call shp.ZOrder( 5 )
    shp.TextFrame.AutoSize = True
    shp.LayoutInCell = false
    shp.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
    shp.Top = wdShapeBottom
    End If

    Call oWord.Selection.Collapse(wdCollapseEnd)
    Call oWord.Selection.GoTo(wdGoToPage, wdGoToNext, 1)
    If CurrPageNum > 0 Then
    CurrPageNum = CurrPageNum + 1
    End If 

    Next
    Call oWord.Selection.Collapse(wdCollapseEnd)

    endsub:
    Exit sub
    errsub:
    MsgBox "SL PrintLib >> Sub AddStamp >> Error " & Error & " on " & erl
    Resume endsub
    End Sub
    Может будет кому-то полезно
     
Загрузка...

Поделиться этой страницей