1. Набираем команду codeby webinar. Набираем команду для организации и проведения вебинаров. Подробнее ...

    Скрыть объявление
  2. Требуются разработчики и тестеры для проекта codebyOS. Требования для участия в проекте: Знание принципов работы ОС на базе Linux; Знание Bash; Крайне желательное знание CPP, Python, Lua; Навыки системного администрирования. Подробнее ...

    Скрыть объявление
  3. Получи 30.000 рублей. Для получения денег необходимо принять участие в конкурсе авторов codeby. С условиями и призами можно ознакомиться на этой странице ...

    Внимание! Регистрация авторов на конкурс закрыта.

    Скрыть объявление

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

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

  1. Bob84

    Bob84 Well-Known Member

    Репутация:
    0
    Регистрация:
    16 май 2012
    Сообщения:
    48
    Симпатии:
    0
    Здравствуйте.
    Есть вордовский документ, в котором на каждой странице вставлено изображение.
    Макросом рисую поверх изображения надписи на каждой странице:
    Код:
    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
    По какой-то причине код последнюю надпись рисовал на предыдущей странице. Дополнил код вначале добавлением разрыва строки и удалением пустых страниц после цикла.
    Код
    Код:
    Call Selection.GoTo(wdGoToPage, wdGoToLast)
    Selection.EndKey Unit:=wdStory
    Selection.insertbreak Type:=wdPageBreak
    добавил к документы аж две страницы (которые потом кодом же удалял).
    После этого такая ошибка перестала проявлятся.
    Собственно вопрос почему в каких-то случаях не удается добавить надпись на последнюю страницу?
    Спасибо.
     
  2. hosm

    hosm * so what *

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

    Bob84 Well-Known Member

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

    Bob84 Well-Known Member

    Репутация:
    0
    Регистрация:
    16 май 2012
    Сообщения:
    48
    Симпатии:
    0
    Собственно мне этот макрос был нужен для перевода его потом на 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
    Может будет кому-то полезно
     
Загрузка...

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